마우스 커서 아래에서 픽셀 색상 가져 오기 - 빠른 방법

Question

마우스 커서 아래에서 픽셀 색상을 실제로 얻는 방법은 있습니까? 마우스 훅이 있는데 마우스를 움직이는 동안 픽셀 색을 읽으려고합니다. ColorPicker의 종류

getPixel 및 BitBlt를 사용한 모든 시도는 대단히 느립니다.

UPDATE - ADDED 코드

unit Unit1; 

{$mode delphi}{$H+} 

interface 

uses 
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, lclintf, Windows; 

type 

    { TForm1 } 

    TForm1 = class(TForm) 
    pnColor: TPanel; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure ms(var message: tmessage); message WM_USER+1234; 
    private 
    { private declarations } 
    public 
    { public declarations } 
    end; 

var 
    Form1: TForm1; 
    DC:HDC; 

    const WH_MOUSE_LL = 14; //for Lazarus 

implementation 

{$R *.lfm} 

{ TForm1 } 

procedure HookMouse(Handle:HWND); stdcall; external 'mhook.dll'; 
procedure UnHookMouse; stdcall; external 'mhook.dll'; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    //Self.Caption := IntToStr(Self.Height); 
    Self.Left:= Screen.Monitors[0].WorkareaRect.Right - Self.Width - 18; 
    Self.Top := Screen.Monitors[0].WorkareaRect.Bottom - Self.Height - 18 - 25; //35 LAZARUS BUG 

    DC := getDC(0); 

    HookMouse(Self.Handle); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    UnHookMouse; 
end; 

procedure TForm1.ms(var message: tmessage); 
var color:TColor; 
begin 
    color := GetPixel(DC, message.WParam, message.LParam); //<-- Extremly slow 
    //format('%d - %d',[message.LParam, message.WParam]); // Edited 

    pnColor.Color:=color; 
end; 

end. 

그리고 DLL

library project1; 

{$mode delphi}{$H+} 

uses 
    Windows, 
    Messages; 

var Hook: HHOOK; 
    hParent:HWND; 

function HookProc(nCode: Integer; MsgID: WParam; Data: LParam): LResult; stdcall; 
var 
    mousePoint: TPoint; 
begin 
    //if nCode = HC_ACTION then 
    //begin 
     mousePoint := PMouseHookStruct(Data)^.pt; 
     PostMessage(hParent, WM_USER+1234, mousePoint.X, mousePoint.Y); 
    //end; 
    Result := CallNextHookEx(Hook,nCode,MsgID,Data); 
end; 

procedure HookMouse(Parent: Hwnd); stdcall; 
begin 
    hParent := parent; 
    if Hook = 0 then Hook:=SetWindowsHookEx(WH_MOUSE_LL,@HookProc,HInstance,0); 
end; 

procedure UnHookMouse; stdcall; 
begin 
    UnhookWindowsHookEx(Hook); 
    Hook:=0; 
end; 

exports 
    HookMouse, UnHookMouse; 

begin 

end. 

업데이트 2 - 하나의 단위 업데이트

unit Unit1; 

{$mode delphi}{$H+} 

interface 

uses 
    Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, lclintf, Windows; 

type 

    { TForm1 } 

    TForm1 = class(TForm) 
    pnColor: TPanel; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    private 
    { private declarations } 
    public 
    { public declarations } 
    end; 

var 
    Form1: TForm1; 
    HookHandle: Cardinal; 
    DC:HDC; 
    timer:Long; 

const WH_HOOK_LL = 14; //for Lazarus 

implementation 

{$R *.lfm} 

{ TForm1 } 

function LowLevelMouseProc(nCode: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall; 
var 
    point:TPoint; 
begin 
    if (nCode >= 0) then 
    begin 
    if(GetTickCount - timer >= 100) then 
    begin 
     point:=PMouseHookStruct(lParam)^.pt; 
     Form1.pnColor.Color := GetPixel(DC,point.X,point.Y); 
     timer := GetTickCount; 
    end; 
    end; 
    Result := CallNextHookEx(HookHandle, nCode, wParam, lParam); 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    //Self.Caption := IntToStr(Self.Height); 
    Self.Left:= Screen.Monitors[0].WorkareaRect.Right - Self.Width - 18; 
    Self.Top := Screen.Monitors[0].WorkareaRect.Bottom - Self.Height - 18 - 25; //35 LAZARUS BUG 

    DC := GetWindowDC(GetDesktopWindow); 
    if HookHandle = 0 then 
    begin 
    HookHandle := SetWindowsHookEx(WH_HOOK_LL, @LowLevelMouseProc, hInstance, 0); 
    end; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    if HookHandle <> 0 then 
    UnhookWindowsHookEx(HookHandle); 

    ReleaseDC(GetDesktopWindow(), DC); 
end; 

end. 

Answer 1

간격이 100ms와 나는 개인적 않을 것 이것에 후크를 사용하십시오. 예 : 예를 들어 간격이 30ms 인 타이머를 사용하고 다음 코드를 사용하여 마우스 커서 아래의 현재 픽셀의 위치와 색상을 결정합니다 (이 코드는 원래 코드 에서처럼 Windows 플랫폼에서만 작동합니다). 나는 당신의 애플리케이션이 WM_TIMER 메시지를 처리 ​​할 수 ​​없기 때문에 (낮은 레벨의 유휴 우선 순위) 메시지를 처리 ​​할 수 ​​없기 때문에 사용자 인터페이스 책임을 지키는 훅의 빈번한 콜백을 처리 할 수 ​​있다고 생각하지 않는다. (자신의 주 스레드 메시지를 처리하기 위해) :

unit Unit1; 

{$mode objfpc}{$H+} 

interface 

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

type 

    { TForm1 } 

    TForm1 = class(TForm) 
    Label1: TLabel; 
    Panel1: TPanel; 
    UpdateTimer: TTimer; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure UpdateTimerTimer(Sender: TObject); 
    private 
    DesktopDC: HDC; 
    public 
    { public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.lfm} 

{ TForm1 } 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    DesktopDC := GetDC(0); 
    if (DesktopDC <> 0) then 
    UpdateTimer.Enabled := True; 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    ReleaseDC(GetDesktopWindow, DesktopDC); 
end; 

procedure TForm1.UpdateTimerTimer(Sender: TObject); 
var 
    CursorPos: TPoint; 
begin 
    if GetCursorPos(CursorPos) then 
    begin 
    Label1.Caption := 'Cursor pos: [' + IntToStr(CursorPos.x) + '; ' + 
     IntToStr(CursorPos.y) + ']'; 
    Panel1.Color := GetPixel(DesktopDC, CursorPos.x, CursorPos.y); 
    end; 
end; 

end.