цвет пикселя в игре

unity · #1 14.10.2011, 22:00

сделал прогу которая в зависимости от цвета жмет на кнопку
(программма делалась для игры)
так вот когда игра в оконом режиме все норм работает но как только
разворачиваеш во весь экран перестает работать (т.е постоянна жмет на кнопку необрашая внимания на цвет пикселя)

вот код проги (немного урезан вконце изза ограничения в 10к символов):

Код:

unit Unit1;
procedure TForm1.startClick(Sender: TObject);
begin
d1:=strtoint(edt1.Text);
d2:=strtoint(edt2.text);
d3:=strtoint(edt3.text);
p1:=(key1.ItemIndex);
p2:=(key2.ItemIndex);
p3:=(key3.ItemIndex);
nkey1.Interval:= d1;
nkey2.Interval:=d2;
nkey3.Interval:=d3;
nkey1.Enabled:= Not(nkey1.Enabled);
nkey2.Enabled:= Not(nkey2.Enabled);
nkey3.Enabled:= Not(nkey3.Enabled);
end;

procedure TForm1.windowClick(Sender: TObject);
begin
hwndtmr.Enabled:= Not(hwndtmr.Enabled);
end;

procedure TForm1.hwndtmrTimer(Sender: TObject);
begin
if (getasynckeystate($13)<>0)  then  //условия на то чтоб было нажатие кнопки
  begin
    GetCursorPos( Pos ); //определяет координаты курсора
    Wnd:= WindowFromPoint( Pos );//запоминает хвид окна который под курсорам
    hwndtmr.Enabled:= Not(hwndtmr.Enabled);
    ShowMessage('окно захваченно!');
  end
end;

procedure TForm1.zdc1Click(Sender: TObject);
begin
zdc1tmr.Enabled:= Not(zdc1tmr.Enabled);
end;

procedure TForm1.zdc1tmrTimer(Sender: TObject);
begin
  GetCursorPos(pos);
DC:=GetDC(0);
colzdc1:=GetPixel(DC,pos.x,pos.y);
ReleaseDC(0,DC);
shp1.brush.Color:=colzdc1;
if (getasynckeystate($13)<>0)  then  //условия на то чтоб было нажатие кнопки
  begin
SetForeGroundWindow(wnd);  
GetCursorPos(pos);
DC:=GetDC(0);
colzdc1:=GetPixel(DC,pos.x,pos.y);
kx1:=Pos.X;
ky1:=Pos.Y;
ReleaseDC(0,DC);
shp1.brush.Color:=colzdc1;
zdc1tmr.Enabled:= Not(zdc1tmr.Enabled);
ShowMessage('цвет захвачен(1)!');
  end

end;

procedure TForm1.zdc2Click(Sender: TObject);
begin
 zdc2tmr.Enabled:= Not(zdc2tmr.Enabled);
end;

procedure TForm1.zdc2tmrTimer(Sender: TObject);
begin
GetCursorPos(pos);
DC:=GetDC(0);
colzdc2:=GetPixel(DC,pos.x,pos.y);
ReleaseDC(0,DC);
shp2.brush.Color:=colzdc2;
if (getasynckeystate($13)<>0)  then  //условия на то чтоб было нажатие кнопки
  begin
    SetForeGroundWindow(wnd);
GetCursorPos(pos);
DC:=GetDC(0);
colzdc1:=GetPixel(DC,pos.x,pos.y);
kx2:=Pos.X;
ky2:=Pos.Y;
ReleaseDC(0,DC);
shp2.brush.Color:=colzdc2;
zdc2tmr.Enabled:= Not(zdc2tmr.Enabled);
ShowMessage('цвет захвачен!(2)');
  end

end;

procedure TForm1.zdc3Click(Sender: TObject);
begin
zdc3tmr.Enabled:= Not(zdc3tmr.Enabled);
end;

procedure TForm1.zdc3tmrTimer(Sender: TObject);
begin
GetCursorPos(pos);
DC:=GetDC(0);
colzdc3:=GetPixel(DC,pos.x,pos.y);
ReleaseDC(0,DC);
shp3.brush.Color:=colzdc3;
if (getasynckeystate($13)<>0)  then  //условия на то чтоб было нажатие кнопки
  begin
    SetForeGroundWindow(wnd);
GetCursorPos(pos);
DC:=GetDC(0);
colzdc3:=GetPixel(DC,pos.x,pos.y);
kx3:=Pos.X;
ky3:=Pos.Y;
ReleaseDC(0,DC);
shp3.brush.Color:=colzdc3;
zdc3tmr.Enabled:= Not(zdc3tmr.Enabled);
ShowMessage('цвет захвачен!(3)');
  end

end;

procedure TForm1.nkey1Timer(Sender: TObject);
begin
if p1<>0 then
begin
DC:=GetDC(0);
colsr:=GetPixel(DC,kx1,ky1);
 if (colsr<>colzdc1)and (p1=1) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F1, 0);
 PostMessage(wnd,WM_KEYUP,vk_F1, 0);
 end;

 if (colsr<>colzdc1)and (p1=2) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F2, 0);
 PostMessage(wnd,WM_KEYUP,vk_F2, 0);
 end;

 if (colsr<>colzdc1)and (p1=3) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F3, 0);
 PostMessage(wnd,WM_KEYUP,vk_F3, 0);
 end;

 if (colsr<>colzdc1)and (p1=3) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F3, 0);
 PostMessage(wnd,WM_KEYUP,vk_F3, 0);
 end;

 if (colsr<>colzdc1)and (p1=4) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F4, 0);
 PostMessage(wnd,WM_KEYUP,vk_F4, 0);
 end;

 if (colsr<>colzdc1)and (p1=5) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F5, 0);
 PostMessage(wnd,WM_KEYUP,vk_F5, 0);
 end;

 if (colsr<>colzdc1)and (p1=6) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F6, 0);
 PostMessage(wnd,WM_KEYUP,vk_F6, 0);
 end;

 if (colsr<>colzdc1)and (p1=7) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F7, 0);
 PostMessage(wnd,WM_KEYUP,vk_F7, 0);
 end;

 if (colsr<>colzdc1)and (p1=8) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F8, 0);
 PostMessage(wnd,WM_KEYUP,vk_F8, 0);
 end;

 if (colsr<>colzdc1)and (p1=9) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F9, 0);
 PostMessage(wnd,WM_KEYUP,vk_F9, 0);
 end;

 if (colsr<>colzdc1)and (p1=10) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F10, 0);
 PostMessage(wnd,WM_KEYUP,vk_F10, 0);
 end;

 if (colsr<>colzdc1)and (p1=11) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F11, 0);
 PostMessage(wnd,WM_KEYUP,vk_F11, 0);
 end;

 if (colsr<>colzdc1)and (p1=12) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F12, 0);
 PostMessage(wnd,WM_KEYUP,vk_F12, 0);
 end;
ReleaseDC(0,DC);
end;
end;

procedure TForm1.nkey2Timer(Sender: TObject);
begin
if p2<>0 then
begin
DC:=GetDC(0);
colsr2:=GetPixel(DC,kx2,ky2);
if (colsr2<>colzdc2)and (p2=1) then
begin
 PostMessage(wnd,WM_KEYDOWN,vk_F1, 0);
 PostMessage(wnd,WM_KEYUP,vk_F1, 0);
end;

if (colsr2<>colzdc2)and (p2=2) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F2, 0);
 PostMessage(wnd,WM_KEYUP,vk_F2, 0);
 end;

 if (colsr2<>colzdc2)and (p2=3) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F3, 0);
 PostMessage(wnd,WM_KEYUP,vk_F3, 0);
 end;

 if (colsr2<>colzdc2)and (p2=3) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F3, 0);
 PostMessage(wnd,WM_KEYUP,vk_F3, 0);
 end;

 if (colsr2<>colzdc2)and (p2=4) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F4, 0);
 PostMessage(wnd,WM_KEYUP,vk_F4, 0);
 end;

 if (colsr2<>colzdc2)and (p2=5) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F5, 0);
 PostMessage(wnd,WM_KEYUP,vk_F5, 0);
 end;

 if (colsr2<>colzdc2)and (p2=6) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F6, 0);
 PostMessage(wnd,WM_KEYUP,vk_F6, 0);
 end;

 if (colsr2<>colzdc2)and (p2=7) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F7, 0);
 PostMessage(wnd,WM_KEYUP,vk_F7, 0);
 end;

 if (colsr2<>colzdc2)and (p2=8) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F8, 0);
 PostMessage(wnd,WM_KEYUP,vk_F8, 0);
 end;

 if (colsr2<>colzdc2)and (p2=9) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F9, 0);
 PostMessage(wnd,WM_KEYUP,vk_F9, 0);
 end;

 if (colsr2<>colzdc2)and (p2=10) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F10, 0);
 PostMessage(wnd,WM_KEYUP,vk_F10, 0);
 end;

 if (colsr2<>colzdc2)and (p2=11) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F11, 0);
 PostMessage(wnd,WM_KEYUP,vk_F11, 0);
 end;

 if (colsr2<>colzdc2)and (p2=12) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F12, 0);
 PostMessage(wnd,WM_KEYUP,vk_F12, 0);
 end;
ReleaseDC(0,DC);
end;
end;

procedure TForm1.nkey3Timer(Sender: TObject);
begin
if p3<>0 then
begin
DC:=GetDC(0);
colsr3:=GetPixel(DC,kx3,ky3);
if (colsr3<>colzdc3)and (p3=1) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F1, 0);
 PostMessage(wnd,WM_KEYUP,vk_F1, 0);
 end;

 if (colsr3<>colzdc3)and (p3=2) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F2, 0);
 PostMessage(wnd,WM_KEYUP,vk_F2, 0);
 end;

 if (colsr3<>colzdc3)and (p3=3) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F3, 0);
 PostMessage(wnd,WM_KEYUP,vk_F3, 0);
 end;

 if (colsr3<>colzdc3)and (p3=3) then
 begin
 PostMessage(wnd,WM_KEYDOWN,vk_F3, 0);
 PostMessage(wnd,WM_KEYUP,vk_F3, 0);
 end;

вот часть кода которыя показывает как я определяю цвет пикселя (и его координаты)

Код:

procedure TForm1.zdc3tmrTimer(Sender: TObject);
begin
GetCursorPos(pos);
DC:=GetDC(0);
colzdc3:=GetPixel(DC,pos.x,pos.y);
ReleaseDC(0,DC);
shp3.brush.Color:=colzdc3;
if (getasynckeystate($13)<>0)  then  //условия на то чтоб было нажатие кнопки
  begin
    SetForeGroundWindow(wnd);
GetCursorPos(pos);
DC:=GetDC(0);
colzdc3:=GetPixel(DC,pos.x,pos.y);
kx3:=Pos.X;
ky3:=Pos.Y;
ReleaseDC(0,DC);
shp3.brush.Color:=colzdc3;
zdc3tmr.Enabled:= Not(zdc3tmr.Enabled);
ShowMessage('цвет захвачен!(3)');
  end

в чем мая ошибка?
как еще можно получить цвет пикселя?
можно ли как вариант делать скриншот и из него узнавать цвет?
(и как это сделать, насколько затратная эта операция в плане загрузки ресурсов компа)

angvelem · #2 14.10.2011, 22:33

Цитата:

Сообщение от unity

можно ли как вариант делать скриншот и из него узнавать цвет?
(и как это сделать, насколько затратная эта операция в плане загрузки ресурсов компа)

Ничего сложного и затратного. Контекст вы уже получили, теперь создайте bitmap с размерами экрана, создайте совместимый контекст от экранного выберите bitmap в полученный ранее контекст и функцией BitBlt скопируйте.

Код:

  DC := GetDC(0);
  MemDC := CreateCompatibleDC(DC);
  MemBmp := CreateCompatibleBitmap(DC, Width, Height); // размеры экрана
  SelectObject(MemDC, MemBmp);
  BitBlt(MemDC, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);

ну и не забыть, всё удалить, когда станет не нужно.

unity · #3 15.10.2011, 00:08

Цитата:

Сообщение от angvelem

Ничего сложного и затратного. Контекст вы уже получили, теперь создайте bitmap с размерами экрана, создайте совместимый контекст от экранного выберите bitmap в полученный ранее контекст и функцией BitBlt скопируйте.

Код:

  DC := GetDC(0);
  MemDC := CreateCompatibleDC(DC);
  MemBmp := CreateCompatibleBitmap(DC, Width, Height); // размеры экрана
  SelectObject(MemDC, MemBmp);
  BitBlt(MemDC, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);

ну и не забыть, всё удалить, когда станет не нужно.

а можите если, у вас есть полный код такого метода определения цвета пикселя, выложить его а то чето я несовсем понемаю

так я посматрю весь код непонятные строки в гугл и пойму

angvelem · #4 15.10.2011, 01:30

Простенький пример в архиве. 1 кнопка - получить цвет точки непосредственно с экрана, 2 кнопка, сначала создать копию экрана в битмапе, затем - также получить цвет точки. Подводите курсор в нужное место и пробелом нажимаете кнопку. Никаких замудрённостей.

unity · #5 15.10.2011, 14:04

ну получилось вот так (просто скопировал ваш код в свой)

Код:

procedure TForm1.zdc1tmrTimer(Sender: TObject);
begin
 bmp := TBitmap.Create;
  bmp.Width  := Screen.Width;
  bmp.Height := Screen.Height;
  bmp.PixelFormat := pf24bit;
GetCursorPos(pos);
DC:=GetDC(0);
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height, DC, 0, 0, SRCCOPY);
colzdc1:= bmp.Canvas.Pixels [pos.x,pos.y];
ReleaseDC(0,DC);
shp1.brush.Color:=colzdc1;

но из за того что нужен постоянный мониторинг, и етовсе в таймере
за сек 30 работы проги съедаеться 2 гига оперативы

наскока я понял скриншот делаеться всего экрана
что затратно, мне будет достаточно скриншота в 1 пиксель
за это наверно отвечает Screen.Width, Screen.Height им надо значение 1

а как заставить делать этот скриншот в определеном месте экрана?
все нашел за это отвечают BitBlt(bmp.Canvas.Handle, 0, 0,Screen.Width, Screen.Height, DC, 0, 0, SRCCOPY);
красные нули

вообщем получилось чтото такое:

Код:

procedure TForm1.zdc1tmrTimer(Sender: TObject);
begin
 bmp := TBitmap.Create;
 bmp.Width  := 1;
  bmp.Height := 1;
 bmp.PixelFormat := pf24bit;
GetCursorPos(pos);
DC:=GetDC(0);
BitBlt(bmp.Canvas.Handle, 0,0, 1, 1, DC, Pos.x,Pos.y, SRCCOPY);
colzdc1:= bmp.Canvas.Pixels [0,0];
ReleaseDC(0,DC);
shp1.brush.Color:=colzdc1;

вроде оперативку нетак хавает )

всеравно правда неработает в полноэкранном режиме наверно там както
спецом сделали чтоб цвет неопределялся (или это из за directx )

какими еще способами можно определить цвет пикселя?

так установил опытным путем что цвет который узнает програма это цвет под полоской очков жизней
очки жизни и прочие показатели героя в блоке который похож на окно в винде, внутри игры его можно свободно перемещать
насколько я понял мне надо его хвид узнать (если он у него есть, гдето читал что даже у флеш анимации в браузере хвид есть свой) и сделать вот так: DC:=GetDC(hwnd)

вот а как узнать этот хвид (например хвид окна игры я узнаю наведением мыши на облость окна, и у меня есть своя мини прога которая показывает
хвид того что под курсором)

angvelem · #6 15.10.2011, 21:33

1. Не, ты конечно молодец. Обрати внимание, я создавал bitmap в событии OnCreate - т.е один раз на сессию программы. Ты умудряешься создавать в таймере, а удалять кто будет? Вот память и "съедается".
2. Для игры, идея с GetDC(0) не прокатит. Нужно знать контекст игры.

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты