Как захватить только область щелчка мыши на экране?

Следующий код делает скриншот рабочего стола при каждом нажатии левой кнопки мыши. Но я хочу сделать снимок экрана только той области, где происходит щелчок мышью, например, если на каком-либо веб-сайте нажата какая-либо кнопка, снимок экрана должен быть только этой кнопки.

введите здесь описание изображения

ГИФ

введите здесь описание изображения

Это возможно?

если да, я буду очень рад, если кто-нибудь покажет пример кода! Заранее спасибо.

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.

ИЗМЕНИТЬ:

Я нашел альтернативу в VB.NET. Но каким может быть решение с кодом Delphi?

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

person Coringa    schedule 29.03.2021    source источник
comment
BitBlt.   -  person IInspectable    schedule 29.03.2021
comment
Вам нужен эффект, который показывает GIF?   -  person Strive Sun    schedule 30.03.2021
comment
the screenshot must be only of this button. Если вы просто нажмете угол кнопки, например правый нижний угол кнопки. Как отобразить скриншот? Я не знаю, как получить экземпляры кнопок на веб-странице, но я думаю, что это как-то связано с CSS. Если вам нужно щелкнуть определенную часть кнопки, чтобы отобразить весь снимок экрана кнопки, я не думаю, что это простая вещь. По крайней мере, вы должны быть знакомы с макетом и свойствами элементов управления на веб-странице.   -  person Strive Sun    schedule 30.03.2021
comment
@StriveSun-MSFT, Do you need the effect that GIF shows? — Да.   -  person Coringa    schedule 30.03.2021


Ответы (1)


Существует простой способ, вы можете обратиться к коду в этой теме ,

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.

Этот код может получить снимок экрана, содержащий положение мыши, просто используйте BitBlt, чтобы указать координаты мыши и размер прямоугольника (размер кнопки), и, наконец, получите нужное изображение BMP. Используйте DrawImage, чтобы нарисовать изображение BMP в прямоугольную рамку, как показано в GIF.

Координаты мыши можно получить, вызвав GetCursorInfo, а размер прямоугольника можно указать в соответствии с вашими потребностями.

Обратите внимание, что после того, как у вас есть координаты мыши, вам нужно вычесть размер половины прямоугольника влево и вверх соответственно, когда вы передаете их в BitBlt.

Например,

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);
person Strive Sun    schedule 30.03.2021