Детектор "командного" пикселя
Хочу рассказать вам о том как делать не надо, но мы все же сделали :) Не буду рассказывать почему мы это сделали (у кого есть опыт, тот и сам догадается что это просто "костыли", для быстрой реализации нужного функционала).
Внезапно возникла потребность что бы клиентское ПО, реагировало на некую команду от сервера, без вмешательство в существующее API. Все что требуется клиенту - изменить реазрешение экрана, когда он "видит" в определенном месте, в браузере зеленый пиксель. Есть зеленый пиксель - изменить разрешение на максимальное, если пикселя нет - разрешение остается таким, которое задано в настройках.
Вот собственно ниже привожу код такого "детектора пикселя". Это фоновый поток \, который постоянно мониторит заданную область экрана. Если найден пиксель - генерирует событие.
unit Color.Detector;
interface
uses
System.SysUtils, System.Classes, System.UITypes, Winapi.Windows, VCL.Graphics;
type
TScreenDetector = class(TThread)
private
DesktopHDC: HDC;
DesktopBMP: TBitmap;
Color: TColor;
Detected: Boolean;
DRect: TRect;
FOnDetect: TProc<Boolean,TColor>;
procedure RefreshBitmap;
protected
procedure Execute; override;
public
constructor Create(AColor: TColor; ADetectRect: TRect);
destructor Destroy; override;
property OnDetect: TProc<Boolean,TColor> read FOnDetect write FOnDetect;
end;
implementation
{ TScreenDetector }
constructor TScreenDetector.Create(AColor: TColor; ADetectRect: TRect);
begin
inherited Create(True);
Detected := False;
Color := AColor;
DRect := ADetectRect;
DesktopHDC := GetDC(GetDesktopWindow);
DesktopBMP := TBitmap.Create;
DesktopBMP.PixelFormat := TPixelFormat.pf16bit;
DesktopBMP.SetSize(DRect.Width, DRect.Height);
end;
destructor TScreenDetector.Destroy;
begin
FreeAndNil(DesktopBMP);
DeleteDC(DesktopHDC);
inherited;
end;
procedure TScreenDetector.RefreshBitmap;
begin
DesktopBMP.Canvas.Lock;
try
BitBlt(DesktopBMP.Canvas.Handle, 0,0, DRect.Width, DRect.Height, DesktopHDC, DRect.Left, DRect.Top , SRCCOPY);
finally
DesktopBMP.Canvas.Unlock;
end;
end;
procedure TScreenDetector.Execute;
var
x,y: integer;
LDetect: Boolean;
begin
while not Terminated do
begin
RefreshBitmap;
LDetect := False;
for x := 0 to DesktopBMP.Width do
for y := 0 to DesktopBMP.Height do
begin
if (DesktopBMP.Canvas.Pixels[x,y] = Color) then
begin
LDetect := True;
Break;
end;
end;
Synchronize(nil,
procedure
begin
if LDetect and not Detected and Assigned(OnDetect) then
begin
Detected := True;
OnDetect(True,Color)
end
else
if not LDetect and Detected and Assigned(OnDetect) then
begin
Detected := False;
OnDetect(False,Color);
end;
end);
Sleep(100);
end;
end;
end.
Перевести код с одного языка на другой не является проблемой в 90% случаев. Но надо "не вырезать", а именно переводить. Потому как каждый язык имеет свои особенности. Хотя Pasсal и С++ очень похожи и отличаются в основном синтаксисом.