Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden? (https://www.delphipraxis.net/207491-wie-kann-nur-der-bereich-des-mausklicks-auf-dem-bildschirm-erfasst-werden.html)

flashcoder 29. Mär 2021 14:28

Delphi-Version: 10.4 Sydney

Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
 
Liste der Anhänge anzeigen (Anzahl: 1)
Der folgende Code erstellt jedes Mal einen Screenshot des Desktops, wenn Sie mit der linken Maustaste klicken. Aber ich möchte einen Screenshot nur von der Region machen, in der Mausklicks auftreten. Wenn beispielsweise auf einer Website auf eine Schaltfläche geklickt wird, darf der Screenshot nur von dieser Schaltfläche stammen.

Das ist möglich?

Wenn ja, würde ich mich sehr freuen, wenn jemand ein Codebeispiel zeigt! Danke im Voraus.

Delphi-Quellcode:
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.
Ich habe in VB.NET eine Alternative gefunden. Aber wie könnte eine Lösung mit Delphi-Code sein?

Delphi-Quellcode:
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

KodeZwerg 29. Mär 2021 22:42

AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
 
Wenn Du magst, schau Dir meine .exe an ob die in etwa das macht was Du brauchst.
Falls ja, ich schreibe dieses Programm demnächst komplett neu und gebe Dir gerne den benötigten part.

Ich habe Deinen Code nicht gestestet, ich bin so vorgegangen, fange Maus ab, reagiere auf links klick mit "beginne viereck malen", das halt in einer loop bis message "links loggelassen" kommt und dann erst von den Bildausschnitt ein photo angefertigt.
Soweit die Theorie des ganzen.

flashcoder 29. Mär 2021 23:41

AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
 
Zitat:

Zitat von KodeZwerg (Beitrag 1486292)
Wenn Du magst, schau Dir meine .exe an ob die in etwa das macht was Du brauchst.
Falls ja, ich schreibe dieses Programm demnächst komplett neu und gebe Dir gerne den benötigten part.

Ich habe Deinen Code nicht gestestet, ich bin so vorgegangen, fange Maus ab, reagiere auf links klick mit "beginne viereck malen", das halt in einer loop bis message "links loggelassen" kommt und dann erst von den Bildausschnitt ein photo angefertigt.
Soweit die Theorie des ganzen.


Das brauche ich, siehe:

https://i.stack.imgur.com/rjc7w.gif

KodeZwerg 30. Mär 2021 02:21

AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
 
Zitat:

Zitat von flashcoder (Beitrag 1486295)

Ahh jetzt verstehe ich "was hinten rauskommen" soll.
Ne, das macht meine app nun wirklich nicht.
Bei Anwendungen könnte man sich per Windows Api mit Childs durchtiterieren bis man control unter maus gefunden hat, Rect abfotographieren, als notlösung eine kopie von etwas was in nähe ist, also feste vorgabe.
alles anscheinend OnClick() triggered.
Also für Windwows gäbe es möglichkeiten für andere zwecke da bin ich ratlos.

pesi 30. Mär 2021 07:16

AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
 
Hey Flashcoder,

Dein Beispiel-GIF zeigt aber auch nicht nur Den oder Den Button sondern nimmt immer ein festes Quadrat von X mal X Pixeln. Ist es wirklich das was Du möchtest oder ist das nur ein nicht ganz optimal gewähltes Beispiel-Gif?
Einen FESTEN Bereich rund um die Mausposition zu kopieren sollte vermutlich nicht so kompliziert umzusetzen sein

flashcoder 30. Mär 2021 08:03

AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
 
Zitat:

Zitat von pesi (Beitrag 1486301)
Hey Flashcoder,

Dein Beispiel-GIF zeigt aber auch nicht nur Den oder Den Button sondern nimmt immer ein festes Quadrat von X mal X Pixeln. Ist es wirklich das was Du möchtest oder ist das nur ein nicht ganz optimal gewähltes Beispiel-Gif?
Einen FESTEN Bereich rund um die Mausposition zu kopieren sollte vermutlich nicht so kompliziert umzusetzen sein

Ja, war nicht schwer. :-D

Delphi-Quellcode:
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  PMouseLLHookStruct = ^TMouseLLHookStruct;

  TMouseLLHookStruct = record
    pt: TPoint;
    mouseData: DWORD;
    Flags: DWORD;
    Time: DWORD;
    dwExtraInfo: Cardinal;
  end;

var
  Form1: TForm1;
  mHook: Cardinal;

implementation

{$R *.dfm}

procedure DrawMouseCursor(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 -
            (CI.ptScreenPos.X - Round(Icon.Width / 2)),
            CI.ptScreenPos.Y - (CI.ptScreenPos.Y - Round(Icon.Height /
            2)), Icon);
        end;
      end;
  finally
    Icon.Free;
  end;
end;

function CaptureWindow(const WindowHandle: HWnd): TBitmap;
var
  DC: HDC;
  pt: TPoint;
  Ico: TIcon;
  IcoInfo: TIconInfo;
begin
  DC := GetWindowDC(WindowHandle);
  Result := TBitmap.Create;
  try
    Ico := TIcon.Create;
    try
      Ico.Handle := GetCursor;
      try
        GetIconInfo(Ico.Handle, IcoInfo);
        Result.Width := Ico.Width;
        Result.Height := Ico.Height;
        GetCursorPos(pt);
        BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, DC,
          pt.X - Round(Ico.Width / 2), pt.Y - Round(Ico.Height / 2), SRCCOPY);
        DrawMouseCursor(Result);
      finally
        Ico.ReleaseHandle;
      end;
    finally
      Ico.Free;
    end;
  finally
    ReleaseDC(WindowHandle, DC);
  end;
end;

procedure ScreenShot;
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp := CaptureWindow(GetDesktopWindow);
    Form1.Image1.Picture.Assign(Bmp);
  finally
    Bmp.Free;
  end;
end;

function LowLevelMouseHookProc(nCode: LongInt; WPARAM: WPARAM; lParam: lParam)
  : LRESULT; stdcall;
var
  info: ^TMouseLLHookStruct absolute lParam;
begin
  Result := CallNextHookEx(mHook, nCode, WPARAM, lParam);

  case WPARAM of
    WM_LBUTTONDOWN:
      begin
        ScreenShot;
        Form1.Label1.Caption := Format('X = %d, Y = %d, LMBtn down',
          [TMouseLLHookStruct(info^).pt.X, TMouseLLHookStruct(info^).pt.Y]);
      end;
    WM_LBUTTONUP:
      Form1.Label1.Caption := Format('X = %d, Y = %d, LMBtn up',
        [TMouseLLHookStruct(info^).pt.X, TMouseLLHookStruct(info^).pt.Y]);
    WM_RBUTTONDOWN:
      Form1.Label1.Caption := Format('X = %d, Y = %d, RMBtn down',
        [TMouseLLHookStruct(info^).pt.X, TMouseLLHookStruct(info^).pt.Y]);
    WM_RBUTTONUP:
      Form1.Label1.Caption := Format('X = %d, Y = %d, RMBtn up',
        [TMouseLLHookStruct(info^).pt.X, TMouseLLHookStruct(info^).pt.Y]);
    WM_MOUSEMOVE:
      Form1.Label1.Caption := Format('X = %d, Y = %d, Move',
        [TMouseLLHookStruct(info^).pt.X, TMouseLLHookStruct(info^).pt.Y]);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  mHook := SetWindowsHookEx(WH_MOUSE_LL, @LowLevelMouseHookProc, HInstance, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  UnhookWindowsHookEx(mHook);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnhookWindowsHookEx(mHook);
end;


Alle Zeitangaben in WEZ +1. Es ist jetzt 07:49 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz