Форум программистов, компьютерный форум, киберфорум
Delphi: Графика, звук, видео
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/7: Рейтинг темы: голосов - 7, средняя оценка - 5.00
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
1

Найти отличия между изображениями

15.03.2016, 14:38. Показов 1448. Ответов 15
Метки нет (Все метки)

Нужно сделать 2 скриншота экрана с интервалом в секунду и найти области где скриншоты отличаются.
Пока смогу сделать только УЖАСНЫМ способом. Он не годится. Тк картинка с отличиями выводится только секунд через 10 - 12..

PS Пишу бота для R2 Online

Delphi
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
    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
begin
     application.ProcessMessages;
 for y:=0 to bmp1.Height do
    begin
      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;
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
15.03.2016, 14:38
Ответы с готовыми решениями:

WPF, работа с изображениями. BitmapImage, BitmapSource, BitmapFrame, и их отличия
Я запутался в них. 1. В чем разница между BitmapImage, BitmapSource, BitmapFrame в общих чертах...

Найти разницу между двумя изображениями
Есть два изображения. Второе - результат кадрирования первого и наложения некоторого изображения...

Нужно найти отличия между двумя столбцами
Нужно найти отличия между двумя столбцами. Сначала из первого вычитаем второй столбец. Затем из...

Как можно найти отличия между двумя данными?
Здравствуйте. Храню данные в json. И есть две записи: Первая: {&quot;Яблоко&quot;, &quot;Апельсин&quot;, &quot;Банан&quot;,...

15
5026 / 3919 / 1296
Регистрация: 14.04.2014
Сообщений: 18,027
Записей в блоге: 18
15.03.2016, 15:51 2
ужасность тут в двух местах
там где написано Application.ProcessMessages. убрать его, уже все взлетит

почему не выполнить в 1-сек таймере этот код два раза?
на второй раз таймер отключается, производится сравнение

я не думаю, что уж так долго оно идет
а если долго, то именно его можно в отдельный поток перебросить
1
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
15.03.2016, 16:51  [ТС] 3
Наличие или отсутствие "application.ProcessMessages;" не влияет на скорость выполнения кода. что так что так с моим ризрешением экрана 1600*900 данный код работает >10 секунд. А надо чтоб работало 1 - МАКСИМУМ 2 секунды. Иначе затея просто бессмысленна.
0
5026 / 3919 / 1296
Регистрация: 14.04.2014
Сообщений: 18,027
Записей в блоге: 18
15.03.2016, 17:04 4
наличие application.ProcessMessages очень влияет на скорость выполнения кода
а вот вместо медленных Pixels есть быстрые ScanLine
http://edn.embarcadero.com/article/29173
1
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
15.03.2016, 17:24  [ТС] 5
И как их прикрутить в мой код? Я в английском не оч силен.. А на другом форуме дельных советов не дали вообще
0
3761 / 3204 / 846
Регистрация: 29.08.2013
Сообщений: 21,165
Записей в блоге: 2
15.03.2016, 17:32 6
а если так http://www.imageen.com/demos/index.html?
там есть Show Image Differences
0
5026 / 3919 / 1296
Регистрация: 14.04.2014
Сообщений: 18,027
Записей в блоге: 18
15.03.2016, 22:03 7
Лучший ответ Сообщение было отмечено stlcrash как решение

Решение

создай приложение с пустой формой
и замени текст юнита на этот
Кликните здесь для просмотра всего текста
Delphi
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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics,
  Controls, Forms, Dialogs, ExtCtrls, StdCtrls;
 
type
  TRGBTriple=packed record
    b,g,r:Byte;
  end;
 
  TRGBTripleArray=array[0..4096] of TRGBTriple;
  pRGBTripleArray=^TRGBTripleArray;
 
  TForm1 = class(TForm)
    procedure b1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure bGoClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    tmr1:TTimer;
    panel1:TPanel;
    bgo:TButton;
    shp1,shp2:TShape;
    scrollbox1:TScrollBox;
    img1:TImage;
 
    procedure FindDiff();
    procedure MakeScreenshot(bmp: TBitmap);
  public
    bmp1:TBitmap;
    bmp2:TBitmap;
  end;
 
var
  Form1: TForm1;
 
 
implementation
 
{$R *.dfm}
 
function Same(t1,t2:TRGBTriple):Boolean;
begin
  result := (t1.r=t2.r) and (t1.g=t2.g) and (t1.b=t2.b);
end;
 
 
procedure TForm1.b1Click(Sender: TObject);
begin
  tmr1.enabled:=true;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  panel1:=TPanel.Create(self);
  Panel1.Height := 45;
  Panel1.Caption := '';
  Panel1.Parent:=Self;
  Panel1.Align := alTop;
 
  bGo := TButton.Create(Self);
  bGo.Caption := 'go';
  bGo.Parent:=Panel1;
  bgo.SetBounds(10,10,50,20);
  bgo.OnClick := bGoClick;
 
  ScrollBox1:=TScrollBox.Create(self);
  ScrollBox1.parent:=self;
  ScrollBox1.Align:=alClient;
 
  img1 := TImage.Create(self);
  img1.Parent := ScrollBox1;
 
  shp1:= TShape.Create(Self);
  shp1.Parent:=Panel1;
  shp1.SetBounds(200,10,25,25);
 
  shp2:= TShape.Create(Self);
  shp2.Parent:=Panel1;
  shp2.SetBounds(230,10,25,25);
 
  tmr1:=TTimer.Create(self);
  tmr1.Enabled := false;
  tmr1.OnTimer:=Timer1Timer;
 
  bmp1:=TBitmap.Create;
  bmp2:=TBitmap.Create;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp1.free;
  bmp2.free;
end;
 
 
procedure TForm1.MakeScreenshot(bmp:TBitmap);
var
  vDesktopDC: HDC;   // variable to store the device context handle of desktop window
begin
  // get the device context handle of current desktop window
  vDesktopDC := GetWindowDC(GetDesktopWindow);
  try
      // adjust the dimension and format of the supplied bitmap to match the screen
      bmp.PixelFormat := pf24bit;
      bmp.Height := Screen.Height;
      bmp.Width := Screen.Width;
 
      // draw the content of desktop into bmp
      BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, vDesktopDC, 0, 0, SRCCOPY);
  finally
    // mark that we have done with the desktop device context
    ReleaseDC(GetDesktopWindow, vDesktopDC);
  end;
end;
 
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  makeScreenshot(bmp2);
  shp1.Brush.Color := clGreen;
  shp2.Brush.Color := clGreen;
  update;
  tmr1.enabled:=false;
  FindDiff();
  shp1.Brush.Color := clWhite;
  shp2.Brush.Color := clWhite;
end;
 
procedure TForm1.bGoClick(Sender: TObject);
begin
  makeScreenshot(bmp1);
  left := Left + 100;
  top := top+100;
  shp1.Brush.Color := clGreen;
  shp2.Brush.Color := clWhite;
  update;
  tmr1.Enabled := true;
end;
 
 
procedure TForm1.FindDiff();
var x,y:integer;
  p1,p2,p3:TRGBTriple;
  a1,a2,a3:PRGBTripleArray;
  res:TBitmap;
const
  w:TRGBTriple=(b:255;g:255;r:255);
begin
  res:=TBitmap.Create;
  res.PixelFormat := pf24bit;
  res.Width := bmp1.Width;
  res.height:=bmp1.height;
  for y:=0 to bmp1.Height-1 do
  begin
    a1:=PRGBTripleArray(bmp1.ScanLine[y]);
    a2:=PRGBTripleArray(bmp2.ScanLine[y]);
    a3:=PRGBTripleArray(res.ScanLine[y]);
    for x := 0 to bmp1.width-1 do
    begin
      p1:=a1[x];
      p2:=a2[x];
      if not same(p1,p2) then
        a3[x]:=p2
      else
        a3[x]:=w;
    end;
  end;
  img1.width:=res.Width;
  img1.Height:=res.Height;
  img1.Picture.Assign(res);
  res.Free;
 end;
 
end.
1
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
16.03.2016, 07:22  [ТС] 8
Вот что вышло:
Огромное спасибо.

Осталась последняя часть задачи. Как полученное изображение разбить на области 20*20 и посчитать в них количество белых пикселей? Получить координаты тех областей, где количество белых пикселей меньше заданного N.
0
5026 / 3919 / 1296
Регистрация: 14.04.2014
Сообщений: 18,027
Записей в блоге: 18
16.03.2016, 07:49 9
Лучший ответ Сообщение было отмечено stlcrash как решение

Решение

ну так получение точки в коде есть
белый цвет - там есть константа W=TRGBTriple(b:255;g:255;r:255);

т.е. задача заключается

1) написать функцию, которая для заданной точки p:TPoint; (TPoint - это тип, уже определенный в делфи, с полями X,Y:integer; )
сравнивает (функция Same есть в тексте) все точки от p.X до p.X+19 от p.Y до p.Y+19 c W
и возвращает количество небелых точек
2) создать динамический массив, в котором будут храниться TPoint
3) с шагом в 20 точек вызывать функцию (1) и если результат >N запоминать точку в массиве (2)
4) вывести на экран список координат, запомненных в массиве (2). Для этого можно открыть отдельную форму содержащую StringGrid из 3 колонок и вывести данные из массива туда.
1
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
16.03.2016, 11:23  [ТС] 10
Да именно это и нужно.
Вот что вышло. Вроде работает
Кликните здесь для просмотра всего текста

Delphi
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
function SumWhiteInRect(const bmp:TBitmap; const Rect:TRect):Integer;
var x,y:Integer;
  p1:TRGBTriple;
  a1:PRGBTripleArray;
const
w:TRGBTriple=(b:255;g:255;r:255);
begin
Result:=0;
  for Y:=Rect.top to Rect.Bottom-1 do
  begin
     a1:=PRGBTripleArray(bmp.ScanLine[y]);
    for x := Rect.Left to Rect.Right do
    begin
      p1:=a1[x];
      if same(p1,w) then inc(Result);
    end;
  end;
end;
 
procedure Detect(const bmp:TBitmap; const N:Integer);
var i,j:Integer;
sun:Integer;
const
 r=20;
begin
  for j:=0 to Bmp.Height div r-1 do
    for i:=0 to Bmp.Width div r-1 do
      begin
      Sun:=SumWhiteInRect(bmp, Rect(i*r,j*r,i*r+r,j*r+r));
      if Sun<N then form1.Memo1.Lines.Add(IntToStr(i*20+10)+':'+IntToStr(j*20+10)); 
      end;
end;
0
5026 / 3919 / 1296
Регистрация: 14.04.2014
Сообщений: 18,027
Записей в блоге: 18
16.03.2016, 12:48 11
вроде все как надо)
отлично.
0
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
20.03.2016, 19:03  [ТС] 12
Все работает. Программа пашит круглые сутки. Благодаря несложным манипуляциям игроки не отличают бота от человека. Осталось еще придумать как отфильтровать картинки моря полностью. А то там есть локации с водой, и она движится. Но в этих локах очень богатый дроп
0
5026 / 3919 / 1296
Регистрация: 14.04.2014
Сообщений: 18,027
Записей в блоге: 18
20.03.2016, 20:50 13
мда (
хочется обратно развидеть тему ((
0
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
12.05.2016, 05:50  [ТС] 14
Новая проблема.
Запихвал вышеописанные процедуры в поток. НО
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TMonDirThread.BrowserScreen(imgW, imgH, X, Y, BlackToWhite: integer;
  BMP: TBitmap);
var
  vDesktopDC: HDC;
begin
  vDesktopDC := GetWindowDC(GetDesktopWindow);
  try
      bmp.PixelFormat := pf24bit;
      bmp.Height := imgH;
      bmp.Width :=imgW;
      BitBlt(bmp.Canvas.Handle, 0,0,imgW,imgH,vDesktopDC,X,Y,SRCCOPY);
      if BlackToWhite<>900 then Threshold(bmp,BlackToWhite,clWhite, clBlack);
  finally
    ReleaseDC(GetDesktopWindow, vDesktopDC);
end;
  application.ProcessMessages;
end;
отказывается корректно работать из создаваемого мной побочного потока. на снимках экрана вместо желаемого результата какая то билиберда. Непонятно что скринится.. Из основного потока точно такая же процедура работает отлично
0
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
01.06.2016, 01:27  [ТС] 15
Необходимо закрасить на КАРТИНКЕ все пиксели с голубоватым и желтым оттенком. Как это реализовать?
0
0 / 0 / 0
Регистрация: 04.03.2016
Сообщений: 40
02.06.2016, 13:42  [ТС] 16
Вот что вышло. но работает очень долго если установить filtersilver/filterVoter.checked:=true; 5-6 секунд.. С false меньше секунды
Delphi
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
function IsColorDiff_InRange(t1: TRGBTriple; rMin, rMax, gMin, gMax, bMin, bMax: Byte): Boolean;
begin
result:=
      (t1.r In [rMin..rMax])
      and
      (t1.g In [gMin..gMax])
      and
      (t1.b In [bMin..bMax]);
end;
 
//Img1-img2
procedure TForm1.FindDiff;
var x,y:integer;
  p1,p2:TRGBTriple;
  a1,a2,a3:PRGBTripleArray;
  res:TBitmap;
  paintOver:boolean;
const
  w:TRGBTriple=(b:255;g:255;r:255);
begin
  res:=TBitmap.Create;
  res.PixelFormat := pf24bit;
  res.Width := bmp1.Width;
  res.height:=bmp1.height;
  for y:=0 to bmp1.Height-1 do
  begin
    a1:=PRGBTripleArray(bmp1.ScanLine[y]);
    a2:=PRGBTripleArray(bmp2.ScanLine[y]);
    a3:=PRGBTripleArray(res.ScanLine[y]);
    for x := 0 to bmp1.width-1 do
    begin
      p1:=a1[x];
      p2:=a2[x];
      if not same(p1,p2) then
      begin
        paintOver:=true;
        if filterVoter.Checked then if IsColorDiff_InRange(p2, Filter1Rmin.Value, Filter1Rmax.Value, Filter1Gmin.Value, Filter1Gmax.Value, Filter1Bmin.Value, Filter1Bmax.Value) then paintOver:=false;
        if (filtersilver.Checked) and (paintOver) then if IsColorDiff_InRange(p2, Filter2Rmin.Value, Filter2Rmax.Value, Filter2Gmin.Value, Filter2Gmax.Value, Filter2Bmin.Value, Filter2Bmax.Value) then paintOver:=false;
        if paintOver then a3[x]:=p2 else a3[x]:=w;
      end
      else
        a3[x]:=w;//закрашиваем пиксель в белый цвет
    end;
  end;
  img1.width:=res.Width;
  img1.Height:=res.Height;
  img1.Picture.Assign(res);
  Detect(res,((HeightWidth.Value*HeightWidth.Value) div 100)*BWPorog.Position);
  res.Free;
end;
Добавлено через 21 минуту
Вынес все глобальные переменные в локальные. стало работать как хотел!
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
02.06.2016, 13:42

Отличия между ++value и value++
Все используют по разному, чем эти отличия отличаются друг от друга. Или ничем ?

Расстояние между изображениями
Изучаю css и html. Что прописать, чтобы не было пробела между картинками? и где лучше в css-файле...

Расстояние между изображениями
Здравствуйте, у меня находятся на сайте 4 изображения, но находятся они слитно друг с другом. Как с...

Просвет между изображениями
Я сделал фоном изображения картинку и сделал картинку в шапку но эти картинки не прилегают друг...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
16
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.