Tipy a triky v Delphi, díl 160. – sledování myši

Dnešní článek vznikl (ostatně jako už mnohokrát) na základě dotazu jednoho ze čtenářů. Naučíme se sledovat pohyb a klikání myši i mimo naší aplikaci.
Možná znáte programy, které vám změří, kolikrát jste kliknuli na jednotlivá tlačítka myši či kolik kilometrů (pixelů) urazil kurzor. Základ je v tom, že musíme být schopni detekovat pohyb a další akce myši i v případě, že je naše aplikace neaktivní či minimalizovaná, zkrátka nemá focus. A to se právě dnes naučíme.

Využijeme k tomu jednak komponentu ApplicationEvents, kterou byste měli nalézt na záložce Additional na paletě komponent a jako obvykle také zprávy systému. To se dalo ostatně očekávat, tímto způsobem se dá zařídit většina podobných věcí. Pomocí zmiňovaných prostředků a funkce JournalProc (viz. dále) se "napíchneme" na zprávy systému, ve funkci JournalProc, kterou si pro tento účel vytvoříme, je pak budeme vyhodnocovat a vypisovat na obrazovku výsledky sledování.

Vytvořme si tedy nový projekt, na prázdný formulář umístíme dvě tlačítka a ListBox. První tlačítko bude zapínat sledování, druhé naopak funkci deaktivuje. Do ListBoxu se budou během sledování vypisovat výsledky, tedy které tlačítko bylo stisknuto či uvolněno a na jaké pozici byl kurzor a rovněž i informace o pootočení kolečka na myši. Samozřejmě musíme přidat na formulář zmiňovanou komponentu ApplicationEvents.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AppEvnts;

type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FHookStarted : Boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

var
  JHook: THandle;

{$R *.dfm}

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;
var
  s: string;
begin
  Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
  if Code < 0 then Exit;
  if Code = HC_SYSMODALON then Exit;
  if Code = HC_ACTION then
  begin
    s := ``;
    if EventStrut.message = WM_LBUTTONUP then s := `Leve tlacitko uvolneno na pozici: [` + IntToStr(EventStrut.paramL) + `, ` + IntToStr(EventStrut.paramH) + `]`;
    if EventStrut.message = WM_LBUTTONDOWN then s := `Leve tlacitko stisknuto na pozici: [` + IntToStr(EventStrut.paramL) + `, ` + IntToStr(EventStrut.paramH) + `]`;
    if EventStrut.message = WM_RBUTTONDOWN then s := `Prave tlacitko stisknuto na pozici: [` + IntToStr(EventStrut.paramL) + `, ` + IntToStr(EventStrut.paramH) + `]`;
    if EventStrut.message = WM_RBUTTONUP then s := `Prave tlacitko uvolneno na pozici: [` + IntToStr(EventStrut.paramL) + `, ` + IntToStr(EventStrut.paramH) + `]`;
    if EventStrut.message = WM_MOUSEWHEEL then s := `Kolecko otoceno na pozici: [` + IntToStr(EventStrut.paramL) + `, ` + IntToStr(EventStrut.paramH) + `]`;
    if EventStrut.message = WM_MOUSEMOVE then s := `Kurzor je na pozici: [` + IntToStr(EventStrut.paramL) + `, ` + IntToStr(EventStrut.paramH) + `]`;
    if s <> `` then Form1.ListBox1.ItemIndex :=  Form1.ListBox1.Items.Add(s);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FHookStarted then
  begin
    ShowMessage(`Mys je jiz sledovana!`);
    Exit;
  end;
  JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
  if JHook > 0 then FHookStarted := True
  else ShowMessage(`Nelze zapnout sledovani`);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  FHookStarted := False;
  UnhookWindowsHookEx(JHook);
  JHook := 0;
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;  var Handled: Boolean);
begin
  Handled := False;
  if (Msg.message = WM_CANCELJOURNAL) and FHookStarted then JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FHookStarted then UnhookWindowsHookEx(JHook);
end;

end.

Jak jste si mohli všimnout, používáme též jednu globální pomocnou proměnnou, která nám hlídá, zda je proces sledování aktivní či nikoliv. Jednotlivé zprávy jsou vyhodnocovány funkcí JournalProc a příslušný výsledek a souřadnice kurzoru jsou vypsány do ListBoxu. Při ukončení aplikace nesmíme zapomenout v události OnClose hlavního formuláře zrušit řádně naše sledování.

Kompletní ukázkový projekt můžete stahovat zde.

Diskuze (3) Další článek: Stáhněte si nové Nero 6 Reloaded přímo z Živě.cz!

Témata článku: Software, Windows, Programování, Sledování, Myši, DEL, Mys, TRI, Trik, Díl, Exit


Určitě si přečtěte

Šest nejlepších služeb a aplikací pro automatizaci online světa a chytré domácnosti

Šest nejlepších služeb a aplikací pro automatizaci online světa a chytré domácnosti

** Nastavte si automatiku na každodenní rutinní záležitosti ** Propojte online služby a chytrou domácnost ** Vybrali jsme šest nejlepších služeb pro automatizaci

Karel Kilián | 14

Čím nahradit Total Commander: 11 správců souborů nejen pro profíky

Čím nahradit Total Commander: 11 správců souborů nejen pro profíky

** Total Commander je fernomén mezi správci souborů ** Našli jsme 11 povedených alternativ ** Zvládnou to samé a ke všemu jsou většinou zadarmo

Karel Kilián | 79

Ubuntu 20.04: Zase vás chce přesvědčit, že je lepší než Windows

Ubuntu 20.04: Zase vás chce přesvědčit, že je lepší než Windows

** Britský Canonical před pár dny vydal novou verzi svého Ubuntu ** 20.04 LTS zapracovalo na grafickém desktopu, rychlosti i bezpečnosti ** V nitru tepe Linux 5.4 a volitelně i nový souborový systém

Jakub Čížek | 118

Geniální programátor Edsger Dijkstra: hledal nové postupy a zavrhoval GoTo

Geniální programátor Edsger Dijkstra: hledal nové postupy a zavrhoval GoTo

** Edsger Dijkstra je osobností historie programování ** Vynalezl algoritmus pro nalezení nejkratší cesty v grafu a dostal Turingovu cenu ** Zasloužil se o blízké propojení programování a matematiky

Jiří Nahodil | 13


Aktuální číslo časopisu Computer

Megatest 24 PC zdrojů

Jak využít umělou inteligenci

10 špičkových sluchátek s ANC

Playstation 5 vs Xbox Series X