Сравнение В Реальном Времени

[oluh123]

нужно в реальном времени определить цвет точки формы, сравнению подвергаются 5-10 точек, хотелось бы добиться скорости в 25-30 циклов проверки в секунду. просто подскажите способ быстрого извлечения цвета точки

form.canvas.pixel возвращает только черный цвет, возможно я что-то делаю не так

заранее спасибо

 

[sinkopa]

нужно в реальном времени определить цвет точки формы, сравнению подвергаются 5-10 точек, хотелось бы добиться скорости в 25-30 циклов проверки в секунду. просто подскажите способ быстрого извлечения цвета точки

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
Shape1: TShape;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function GetColor(const WinHandle: HWND; Coordinates: TPoint): TColor;
var
Canvas: TCanvas;
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetWindowDC(WinHandle);
Result := GetPixel(Canvas.Handle, Coordinates.X, Coordinates.Y);
finally
Canvas.Free;
end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
P: TPoint;
begin
GetCursorPos(P);
{получить цвет пикселя под курсором в любой точке экрана }
Shape1.Brush.Color := GetColor(GetDesktopWindow,P);

{ или... цвет пикселя под курсором в любой точке формы }
// P := Self.ScreenToClient(P);
// Inc(P.X, Width - ClientWidth);
// Inc(P.Y, Height - ClientHeight);
// Shape1.Brush.Color := GetColor(Self.Handle,P);

{ или... цвет пикселя в указанной координате на форме }
// P := Point(35,65);
// Inc(P.X, Width - ClientWidth);
// Inc(P.Y, Height - ClientHeight);
// Shape1.Brush.Color := GetColor(Self.Handle,P);

Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled := not Timer1.Enabled;
end;
end.

Проект в аттаче
Посмотреть вложение PixelColorTest.rar

 

[AndreyS]

Тебе необходимо сделать выполнение циклов (проверки) не в один поток а в несколько

Почитай про много поточность

 

[oluh123]

мультипоточность не обязательна. достаточно быстро проверять ряд точек

function GetColor(const WinHandle: HWND; Coordinates: TPoint): TColor;
var
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := GetWindowDC(WinHandle);
    Result := GetPixel(Canvas.Handle, Coordinates.X, Coordinates.Y);
  finally
    Canvas.Free;
  end;
end;

а если сделать привязку конвы глобальной, а не часть функции, возврат пикселя будет будет в реальном времени или только то, что было на момент привязки?

 

[sinkopa]

а если сделать привязку конвы глобальной, а не часть функции, возврат пикселя будет будет в реальном времени или только то, что было на момент привязки?

Я не понял что Вы имели в виду говоря "глобальная канва"... но в приведенном (выше) мной примере, "возврат пикселя" происходит на момент вызова функции GetPixel.
Если Вам требуется произвести замеры ВСЕХ координат в единой временной точке, канву нужно залочить:

type
TColors = array of TColor;
//...
function GetColors(const WinHandle: HWND; Points: array of TPoint; var Colors: TColors): Boolean;
var
Canvas: TCanvas;
i: Integer;
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetWindowDC(WinHandle);
Result := Canvas.TryLock; // лочим канву
SetLength(Colors, Length(Points));
for i := 0 to High(Points) do // замеряем состояния точек на момент вызова Canvas.TryLock
Colors[i] := GetPixel(Canvas.Handle, Points[i].X, Points[i].Y);
finally
if Result then
Canvas.Unlock;
ReleaseDC(0, Canvas.Handle);
Canvas.Free;
end;
end;

тестовый проект в аттаче
Посмотреть вложение PicselColorTest2.rar

 

[oluh123]

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Timer1: TTimer;
Button1: TButton;
Shape1: TShape;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
end;

var
Form1: TForm1;
Canvas: TCanvas;

implementation

{$R *.dfm}

Canvas := TCanvas.Create;
try
Canvas.Handle := GetWindowDC(WinHandle); // привязка переменной

//функции, расчеты и блаблабла // возврат цвета через GetPixel

finally
Canvas.Free;

end.

Такая структура будет возвращать цвет точки в момент обращения или в момент привязки переменной?

 

[-master-]

Читать не умеете?

 

[sinkopa]

var
Form1: TForm1;
Canvas: TCanvas;

implementation

{$R *.dfm}

Canvas := TCanvas.Create;
try
Canvas.Handle := GetWindowDC(WinHandle[/b]); // привязка переменной
//функции, расчеты и блаблабла // возврат цвета через GetPixel

[b]finally
Canvas.Free;[/b]

end.

Такая структура будет возвращать цвет точки в момент обращения или в момент привязки переменной?

Если моментом обращения Вы называете GetPixel... то да, на момент обращения...
Только обращаю Ваше внимание - "буквари" настоятельно рекомендуют переменную Canvas: TCanvas; делать локальной переменной. Это гарантирует, что на выходе из процедуры переменная будет разрушена и "занилина" (приведена в nil)... Это важно для освобожения захваченной Вами "чужой" канвы.
В Вашем варианте, последовательность ReleaseDC(0, Canvas.Handle); Canvas.Free; Canvas := nil; обязательна... хотя все равно не гарантирует от возникновения ошибок (например в случае если канву пытается захватить параллельный поток или система)...

 

[oluh123]

ясненько, спасибо всем