* * *

Author Topic: Capturing the cursor on a screenshot on Linux  (Read 642 times)

rc.1990

  • New member
  • *
  • Posts: 47
Capturing the cursor on a screenshot on Linux
« on: May 30, 2017, 07:08:09 pm »
In previous discussion, we got a solution for Windows, now I am searching for a solution on Linux.
http://forum.lazarus.freepascal.org/index.php/topic,37034

Is there a way to get the cursor on a full screenshot for Linux?
Or how can I adapt/replace DrawIconEx below on Linux?

Code: Pascal  [Select]
  1. uses
  2.   LCLIntf, LCLType, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  3.   StdCtrls, ExtCtrls, JPEGLib;
  4.  
  5. ...
  6.  
  7. procedure DrawCursor (ACanvas: TCanvas; Position: TPoint) ;
  8. var
  9.   HCursor : THandle;
  10.   Screen: TScreen;
  11. begin
  12.   HCursor := GetCursor;
  13.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  14.              HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  15. end;


The whole example source code:
Code: Pascal  [Select]
  1. unit ScreenShotUnit;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   LCLIntf, LCLType, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  9.   StdCtrls, ExtCtrls, JPEGLib;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Button1: TButton;
  17.     procedure Button1Click(Sender: TObject);
  18.   private
  19.     { private declarations }
  20.   public
  21.     { public declarations }
  22.   end;
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. {$R *.lfm}
  30.  
  31. { TForm1 }
  32.  
  33. procedure DrawCursor (ACanvas: TCanvas; Position: TPoint) ;
  34. var
  35.   HCursor : THandle;
  36.   Screen: TScreen;
  37. begin
  38.   HCursor := GetCursor;
  39.   DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
  40.              HCursor, 32, 32, 0, 0, DI_NORMAL) ;
  41. end;
  42.  
  43. procedure TForm1.Button1Click(Sender: TObject);
  44. var
  45.   MyBitmap: TBitmap;
  46.   ScreenDC: HDC;
  47.   CurPos: TPoint;
  48.   Image2: TImage;
  49. begin
  50.   MyBitmap := Graphics.TBitmap.Create;
  51.   try
  52.     ScreenDC := GetDC(0);
  53.     try
  54.       MyBitmap.LoadFromDevice(ScreenDC);
  55.     finally
  56.       ReleaseDC(0,ScreenDC);
  57.     end;
  58.     Image2 := TImage.Create(self);
  59.     Image2.picture := TPicture(MyBitmap);
  60.  
  61.     GetCursorPos(CurPos);
  62.     DrawCursor(MyBitmap.Canvas, CurPos);
  63.  
  64.     MyBitmap.SaveToFile('FullScreenCap.bmp');
  65.     Image2.Picture.SaveToFile('FullScreenCap.jpg');
  66.     Image2.Picture.SaveToFile('FullScreenCap.png');
  67.   finally
  68.     MyBitmap.Free;
  69.     Image2.Free;
  70.   end;
  71.   ShowMessage('Screen captured.');
  72. end;
  73.  
  74. end.

dstaniak

  • Newbie
  • Posts: 1
Re: Capturing the cursor on a screenshot on Linux
« Reply #1 on: September 13, 2017, 09:37:47 am »
Hi, did you ever get a solution for this? Now I'm working on the same subject and cannot get any results.

benohb

  • Full Member
  • ***
  • Posts: 141
Re: Capturing the cursor on a screenshot on Linux
« Reply #2 on: September 14, 2017, 03:44:33 pm »



 ::)  Try this


Code: Pascal  [Select]
  1. uses
  2. ................ xlib,x,ctypes;


Code: Pascal  [Select]
  1. type
  2.  
  3.  
  4.   PXFixesCursorImage = ^TXFixesCursorImage;
  5.   TXFixesCursorImage = record
  6.     x, y: cshort;
  7.     width, height: cushort;
  8.     xhot, yhot: cushort;
  9.     cursor_serial: culong;
  10.     pixels: Pculong;
  11.     atom: TAtom;                    { Version >= 2 only }
  12.     namer: PChar;                    { Version >= 2 only }
  13.   end;
  14. function XFixesGetCursorImage(dis:PDisplay):PXFixesCursorImage;cdecl;external 'libXfixes';
  15.  


Code: Pascal  [Select]
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var  display:PDisplay;
  3. hh:PXFixesCursorImage;
  4.       gg,tt,gf:Integer;
  5.       goog:TBitmap;
  6.       vv:pbyte;
  7.  
  8.  
  9. begin
  10.   display :=XOpenDisplay(nil);
  11.      goog:= TBitmap.Create;
  12.      goog.Transparent:=true;
  13.     hh:=XFixesGetCursorImage(display);
  14.  
  15.  
  16.     goog.Width:=hh^.width;
  17.     goog.Height:=hh^.height;
  18.       gf:=0;
  19.   for  gg := 0 to hh^.height-1 do
  20.      for  tt := 0 to hh^.width-1 do
  21.       begin
  22.          vv:= @hh^.pixels[gf];
  23.          goog.Canvas.Pixels[tt,gg]:=RGBToColor(vv[2],vv[1],vv[0]);
  24.          Inc(gf);
  25.         end;
  26.  
  27.  
  28.  
  29.  
  30.    Canvas.Draw(0,0,goog);
  31.     goog.Free;
  32.      XCloseDisplay(display);
  33.  
  34.  
  35. end;
  36.  


 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus