AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Wie kann nur der Bereich des Mausklicks auf dem Bildschirm erfasst werden?

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

Ein Thema von flashcoder · begonnen am 29. Mär 2021 · letzter Beitrag vom 30. Mär 2021
Antwort Antwort
flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#1

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

  Alt 29. Mär 2021, 15:28
Delphi-Version: 10.4 Sydney
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
Angehängte Grafiken
 

Geändert von flashcoder (29. Mär 2021 um 20:53 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.685 Beiträge
 
Delphi 11 Alexandria
 
#2

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

  Alt 29. Mär 2021, 23:42
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.
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#3

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

  Alt 30. Mär 2021, 00:41
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
  Mit Zitat antworten Zitat
Benutzerbild von KodeZwerg
KodeZwerg

Registriert seit: 1. Feb 2018
3.685 Beiträge
 
Delphi 11 Alexandria
 
#4

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

  Alt 30. Mär 2021, 03:21
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.
Gruß vom KodeZwerg
  Mit Zitat antworten Zitat
pesi

Registriert seit: 29. Aug 2003
Ort: 36217 Ronshausen
117 Beiträge
 
Delphi XE5 Professional
 
#5

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

  Alt 30. Mär 2021, 08:16
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
  Mit Zitat antworten Zitat
flashcoder

Registriert seit: 10. Nov 2013
83 Beiträge
 
#6

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

  Alt 30. Mär 2021, 09:03
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.

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;
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:32 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