![]() |
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:
Ich habe in VB.NET eine Alternative gefunden. Aber wie könnte eine Lösung mit Delphi-Code sein?
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.
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 |
AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
Wenn Du magst, schau Dir
![]() 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. |
AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
Zitat:
Das brauche ich, siehe: ![]() |
AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
Zitat:
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. |
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 |
AW: Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?
Zitat:
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 01:18 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz