Показать сообщение отдельно
  #1  
Старый 02.10.2015, 16:23
Аватар для Alloc
Alloc Alloc вне форума
Начинающий
 
Регистрация: 17.09.2014
Сообщения: 104
Версия Delphi: Delphi 7
Репутация: 10
По умолчанию Быстрое определение цвета пикселя по 4-ем позициям

Приветствую!

Очень прошу понимающих людей объяснить мне как реализовать поставленную задачу.

Определить цвет пикселя (одного) не проблема, цвет программа определяет мгновенно, а вот если мониторить сразу 4 - проблема.. программа часто не срабатывает при нахождение цвета...

Я делаю так:

Код:
var
  bmp: TBitmap;
  h1: HWND;
  DC: HDC;
  dx,dy,fx,fy,jx,jy,kx,ky: Integer;

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp := TBitmap.Create;
  bmp.Width := 1; bmp.Height := 1;
  bmp.PixelFormat := pf32bit;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ReleaseDC(h1,DC);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  h1 := FindWindow(ProgName, nil);
  DC := GetDC(FindWindow(ProgName,''));
  
  //Если программа запущена задаем координаты которые будем проверять. Кстати таймеры все стоят на интервале равным = 1
  if h1 <> 0 then
     begin
       dx:=646;
       dy:=715; 
       fx:=724; 
       fy:=715; 
       jx:=802;
       jy:=715; 
       kx:=843; 
       ky:=715;

       //Включаем таймеры которые будут это делать (каждый будет смотреть свой пиксель)

       tmr1.Enabled:=True;
       tmr2.Enabled:=True;
       tmr3.Enabled:=True;
       tmr4.Enabled:=True;
     end else
     begin
       ShowMessage('Game Not Started');
     end;
end;

//Таких таймеров 4 штуки. Код в них похож, только координаты пикселей разные и сравниваемый цвет.

procedure TForm1.tmr1Timer(Sender: TObject);
var
  c: TColor;
  rr,gg,bb: Integer;
begin
  BitBlt(bmp.Canvas.Handle,0,0,1,1,dc,dx,dy,SRCCOPY);
  //releasedc(h1,dc);
  c := pinteger(bmp.Scanline[0])^;
  c := ((c and $FF) shl 16) or (c and $FF00) or ((c shr 16) and $FF);
  rr:=GetRValue(c);
  gg:=GetGValue(c);
  bb:=GetBValue(c);

  if (rr>80) and (gg>80) and (bb>100) then EmulateKey(h1, Ord('D'));

end;

...
procedure TForm1.tmr2Timer(Sender: TObject);
...
procedure TForm1.tmr3Timer(Sender: TObject);
...
procedure TForm1.tmr4Timer(Sender: TObject);
...

Если один таймер стоит - все работает. Два - более или менее тоже а вот 4 уже то срабатывает то нет...
Как лучше и правильнее сделать? Я буду вам очень благодарен за помощь.
Ответить с цитированием