How capture only the region of mouse click on screen? - delphi

Question

The code following makes a screenshot of desktop every time that mouse left button is clicked.
But i'm wanting make a screenshot only of region where happens mouse click, for example if some button is clicked on some website, the screenshot must be only of this button.
GIF
This is possible?
if yes, i will very happy if someone show a code example! Thanks in advance.
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
Windows,
Messages,
SysUtils,
Graphics,
Imaging.PngImage;
type
MouseLLHookStruct = record
end;
const
WH_MOUSE_LL = 14;
var
Msg: TMsg;
mHook: Cardinal;
procedure GetCursor(ScreenShotBitmap: TBitmap);
var
R: TRect;
Icon: TIcon;
II: TIconInfo;
CI: TCursorInfo;
begin
R := ScreenShotBitmap.Canvas.ClipRect;
Icon := TIcon.Create;
try
CI.cbSize := SizeOf(CI);
if GetCursorInfo(CI) then
if CI.Flags = CURSOR_SHOWING then
begin
Icon.Handle := CopyIcon(CI.hCursor);
if GetIconInfo(Icon.Handle, II) then
begin
ScreenShotBitmap.Canvas.Draw(CI.ptScreenPos.X - Integer(II.xHotspot) -
R.Left, CI.ptScreenPos.Y - Integer(II.yHotspot) - R.Top, Icon);
end;
end;
finally
Icon.Free;
end;
end;
procedure ScreenCapture;
var
DC: HDC;
Rect: TRect;
png: TPngImage;
Bitmap: TBitmap;
begin
png := TPngImage.Create;
Bitmap := TBitmap.Create;
GetWindowRect(GetDesktopWindow, Rect);
DC := GetWindowDC(GetDesktopWindow);
try
Bitmap.Width := Rect.Right - Rect.Left;
Bitmap.Height := Rect.Bottom - Rect.Top;
BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, DC, 0,
0, SRCCOPY);
GetCursor(Bitmap);
png.Assign(Bitmap);
png.SaveToFile('screenshot.png');
finally
ReleaseDC(GetDesktopWindow, DC);
png.Free;
Bitmap.Free;
end;
end;
function LowLevelMouseHookProc(nCode: LongInt; WPARAM: WPARAM; lParam: lParam)
: LRESULT; stdcall;
var
info: ^MouseLLHookStruct absolute lParam;
begin
Result := CallNextHookEx(mHook, nCode, WPARAM, lParam);
if (WPARAM = WM_LBUTTONUP) then
ScreenCapture;
end;
begin
mHook := SetWindowsHookEx(WH_MOUSE_LL, #LowLevelMouseHookProc, HInstance, 0);
while GetMessage(Msg, 0, 0, 0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
UnhookWindowsHookEx(mHook);
end.
EDIT:
I found a alternative in VB.NET. But how could be a solution with Delphi code?
Private Shared Function CaptureCursor(ByRef x As Integer, ByRef y As Integer) As Bitmap
Dim bmp As Bitmap
Dim hicon As IntPtr
Dim ci As New CURSORINFO()
Dim icInfo As ICONINFO
ci.cbSize = Marshal.SizeOf(ci)
If GetCursorInfo(ci) Then
hicon = CopyIcon(ci.hCursor)
If GetIconInfo(hicon, icInfo) Then
x = ci.ptScreenPos.X - CInt(icInfo.xHotspot)
y = ci.ptScreenPos.Y - CInt(icInfo.yHotspot)
Dim ic As Icon = Icon.FromHandle(hicon)
bmp = ic.ToBitmap()
ic.Dispose()
Return bmp
End If
End If
Return Nothing
End Function
'Insert on Timer tick event
Private Sub Screenshot()
Dim x As Integer
Dim y As Integer
Dim cursorBmp As Bitmap = CaptureCursor(x, y)
Dim bmp As New Bitmap(Cursor.Size.Width, Cursor.Size.Height)
Dim sourceLocation As Point = Control.MousePosition
sourceLocation.Offset(-16, -16)
Using g As Graphics = Graphics.FromImage(bmp)
g.CopyFromScreen(sourceLocation, Point.Empty, bmp.Size)
g.DrawImage(cursorBmp, x - sourceLocation.X, y - sourceLocation.Y)
cursorBmp.Dispose()
End Using
Me.PictureBox1.Image = bmp
End Sub

Answer 1

There is a simple way, you can refer to the code in this thread,
program Project2;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Graphics;
procedure DrawCursor (ACanvas:TCanvas; Position:TPoint) ;
var
HCursor : THandle;
begin
HCursor := GetCursor;
DrawIconEx(ACanvas.Handle, Position.X, Position.Y,
HCursor, 32, 32, 0, 0, DI_NORMAL) ;
end;
function CaptureWindow(const WindowHandle: HWnd): TBitmap;
var
DC: HDC;
wRect: TRect;
CurPos: TPoint;
begin
DC := GetWindowDC(WindowHandle);
Result := TBitmap.Create;
try
GetWindowRect(WindowHandle, wRect);
Result.Width := wRect.Right - wRect.Left;
Result.Height := wRect.Bottom - wRect.Top;
BitBlt(Result.Canvas.Handle,
0,
0,
Result.Width,
Result.Height,
DC,
0,
0,
SRCCOPY);
GetCursorPos(CurPos);
DrawCursor(Result.Canvas, CurPos);
finally
ReleaseDC(WindowHandle, DC);
end;
end;
// Sample usage starts here
var
Bmp: TBitmap;
begin
Bmp := CaptureWindow(GetDesktopWindow);
Bmp.SaveToFile('D:\TempFiles\FullScreenCap.bmp');
Bmp.Free;
WriteLn('Screen captured.');
ReadLn;
end.
This code can get the screen capture containing the mouse position, just use BitBlt to specify the mouse coordinates and rectangle size (button size), and finally get the BMP image you need. Use DrawImage to draw the BMP image into a rectangular box, as shown in GIF.
Mouse coordinates can be obtained by calling GetCursorInfo, and the size of the rectangle can be specified according to your needs.
Note that after you have the mouse coordinates, you need to subtract the size of half a rectangle to the left and up respectively when you pass them into BitBlt.
For example,
BitBlt(Newhdc,
0,
0,
rect_x, //size of the rect
rect_y,
HDC,
x - half_rect_x, //x,y => mouse coordinates
y - half_rect_y, //half_rect_x, half_rect_y => the size of half the rectangle
SRCCOPY);