Get pixel color under mouse cursor - FAST way

Question

Is there ANY way to get pixel color under mouse cursor really FAST? I have a mouse hook and I try to read pixel color during mouse move. Its kind of ColorPicker

Any attempts with getPixel and BitBlt were terribly slow.

UPDATE - ADDED CODE

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. 

And the 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.

UPDATE 2 - One unit update with 100ms interval

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

I wouldn't personally use a hook for this. I would use e.g. a timer with interval 30ms for instance and use the following code to determine position and color of the current pixel under the mouse cursor (the code will work only on Windows platform as your original code can). I'd use this, as because if your application won't be able to process (low level idle priority though) WM_TIMER messages, I don't think it will be able to process so frequent callbacks from your hook keeping the user interface responsible (to process own main thread messages):

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.