Get Pixel Color Under Mouse Cursor(SOLVED)

[wjackson153]

Below is the complete source  to get pixel color from mouse coordinates On linux and Mac.

Best of all it works system wide,  its not limited to your application window in otherwords.

All Credits go to Tazz  because without his knowledge I don't feel I would have ever accomplished
such a task.


And who said linux can't do what windows can

Code: [Select]


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,LCLIntf,
  lcltype, ExtCtrls, StdCtrls, MouseAndKeyInput;

type

  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Shape1: TShape;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function ScreenColor(aX, aY: integer):TColor;
var
  ScreenDC: HDC;
  SaveBitmap: TBitmap;
begin
  SaveBitmap := TBitmap.Create;
  try
    SaveBitmap.SetSize(Screen.Width, Screen.Height);
    ScreenDC := GetDC(0);
    try
      SaveBitmap.LoadFromDevice(ScreenDC);
    finally
      ReleaseDC(0, ScreenDC);
    end;
    Result := SaveBitmap.Canvas.Pixels[aX, aY];

  finally
    SaveBitmap.Free;
  end;
end;

 function ColorToHex(Color: TColor): string;
begin
  if Color <> $0 then
    Result := IntToHex(GetRValue(Color), 2) + IntToHex(GetGValue(Color), 2) +
      IntToHex(GetBValue(Color), 2)
  else
    Result := '000000';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Application.ProcessMessages;
  Label1.caption := IntToStr(Mouse.CursorPos.X);
  Label2.caption := IntToStr(Mouse.CursorPos.Y);

  Shape1.Brush.Color := ScreenColor(Mouse.CursorPos.X,Mouse.CursorPos.Y);
  label3.caption := ColorToHex(shape1.Brush.Color);


end;



end.




[exdatis]

Try:
http://wiki.freepascal.org/BGRABitmap
http://wiki.freepascal.org/BGRABitmap#Direct_access_to_pixels

[exdatis]

Also:
http://forum.lazarus.freepascal.org/index.php/topic,21172.0.html

[wjackson153]

So they only way to get a pixel under a mouse   is first to convert your desktop into a image  ???

Am I understanding this correctly?

[taazz]

depends, is the pixel inside your application boundaries? If yes is it part of a TWinControl descendant? If yes do you use QT wideset? If no then try myColor := Myobject.Canvas.pixels[X,Y]; Where X & Y are relative to the controls client area ee 0,0 is at the top left of the control not the top left of the screen. In all other cases create a bitmap from the desktop and retrieve the pixel from there.

[wjackson153]

That is my problem the pixel is out side of my application.

Im currently using Arch Linux,  as stated in earlier post,  being how this is linux enviroment
there is no documentation on how to achieve what im needing to do.

And as stated also in earlier post  using grabc  , freezes my app untill the left mouse click
is sent to the process.

This works fine from a terminal window    grabc Xdotool click 1
problem is  when passed as a parameter through tprocess it appears that only grabc is accepted
and xdotool is ignored.

I just need a simple example to get the pixel, so where my app knows what pixel was chosen according to my mouse x,y coordinates,   I know how to do everything,  move mouse to said x,y coordinates, capturing x,y current position etc.   What im failing at is grabing the pixel at said coordinates

[taazz]

well if you search the forums for screen shot you will find a number of threads that tackle the problem  for Example http://forum.lazarus.freepascal.org/index.php/topic,19478.msg111064.html#msg111064 which can be changed to

Code: [Select]

function ScreenColor(aX, aY: integer):TColor;
var
  ScreenDC: HDC;
  SaveBitmap: TBitmap;
begin
  SaveBitmap := TBitmap.Create;
  try
    SaveBitmap.SetSize(Screen.Width, Screen.Height);
    ScreenDC := GetDC(0);
    try
      SaveBitmap.LoadFromDevice(ScreenDC);
    finally
      ReleaseDC(0, ScreenDC);
    end;
    Result := SaveBitmap.Canvas.Pixels[aX, aY];
  finally
    SaveBitmap.Free;
  end;
end;


[wjackson153]

Thanks for the example tazz   but im not sure that this works for linux   ?


Your example gives me multiple errors that I do not comprehend.

unit1.pas(222,22) Error: Identifier not found "GetDC"
unit1.pas(226,16) Error: Identifier not found "ReleaseDC"
unit1.pas(228,12) Error: Identifier not found "Result"
unit1.pas(228,42) Error: Identifier not found "aX"
unit1.pas(228,46) Error: Identifier not found "aY"
unit1.pas(234,4) Fatal: Syntax error, "." expected but ";" found

[taazz]

add LCLIntf in to your uses clause and people have testify that the code works for windows, linux and if I remember correctly MacOS too. Personally I have tested it on windows only.

[wjackson153]

Ok  now its compiling but nothing is appearing to happen

cant find the image it saved anywhere on my comp,  nor a is it on the forms canvas

Also   in the following

Code: [Select]


begin
  Application.ProcessMessages;
   SaveBitmap := TBitmap.Create;
  try
    SaveBitmap.SetSize(200, 200);
    ScreenDC := GetDC(0);

    try
      SaveBitmap.LoadFromDevice(ScreenDC);
    finally
      ReleaseDC(0, ScreenDC);
    end;
    Result := SaveBitmap.Canvas.Pixels[mouse.CursorPos.X, mouse.cursorPos.y];
  finally
    SaveBitmap.Free;
    showMessage('Done');

  end;             



Result := SaveBitmap.Canvas.Pixels[mouse.CursorPos.X, mouse.cursorPos.y];

Im not entirely sure as to what Result should be defined as ?  LongInt,  Integer, Real  etc

[taazz]

1) I gave you a complete function that you could use to read the color on a X,Y screen position including the result type you are asking.
2) the function is changed to return a color not to save a bitmap if you want a bitmap saved use the original procedure from the thread I linked in my last message.

[wjackson153]

here is my complete code

Code: [Select]


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,LCLIntf;

type

  { TForm1 }

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

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin

end;

function ScreenColor(aX, aY: integer):TColor;
var
  ScreenDC: HDC;
  SaveBitmap: TBitmap;
begin
  SaveBitmap := TBitmap.Create;
  try
    SaveBitmap.SetSize(Screen.Width, Screen.Height);
    ScreenDC := GetDC(0);
    try
      SaveBitmap.LoadFromDevice(ScreenDC);
    finally
      ReleaseDC(0, ScreenDC);
    end;
    Result := SaveBitmap.Canvas.Pixels[aX, aY];
  finally
    SaveBitmap.Free;
  end;
end;

end.




Im trying to use your example  but its the following errors.

unit1.pas(38,16) Error: Identifier not found "HDC"
unit1.pas(38,16) Error: Error in type definition
unit1.pas(46,41) Error: Incompatible type for arg no. 1: Got "<erroneous type>", expected "HDC"
rasterimage.inc(342,24) Hint: Found declaration: TRasterImage.LoadFromDevice(HDC);
unit1.pas(48,28) Error: Incompatible type for arg no. 2: Got "<erroneous type>", expected "HDC"
winapi.inc(798,10) Hint: Found declaration: ReleaseDC(HWND,HDC):LongInt;
unit1.pas(58) Fatal: There were 4 errors compiling module, stopping

[taazz]

add lcltype to the uses clause.

[wjackson153]

Ok , now were getting somewhere


But this does not appear to be working with ,  however I get no errors

Im trying to call the function as you posted,  but using real time x,y coordinates

Application.ProcessMessages;
  Label1.caption := IntToStr(Mouse.CursorPos.X);
  Label2.caption := IntToStr(Mouse.CursorPos.Y);

  Shape1.Color := ScreenColor(Mouse.CursorPos.X,Mouse.CursorPos.Y);   // no color changes  am i missing something ?
                       

[taazz]

Why don't you zip up a small test application that shows your problem so any one that wants to test it can do so? As it is now there is not enough info to even begin speculating what might be wrong. The code you have shown should work correctly.