unit Unit1;

interface

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

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

var
   Form1: TForm1;


implementation

{$R *.dfm}

var
   JHook: THandle;

//Синтаксис

// JournalPlaybackProc(
// nCode: Integer; {код хука}
// wParam: WPARAM; {этот параметр не используется}
// lParam: LPARAM {ссылка на структуру TEventMsg}
// ): LRESULT;


function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer;
stdcall;
var
   Char1: PChar;
   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 := 'Left Mouse UP at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if EventStrut.message = WM_LBUTTONDOWN then
       s := 'Left Mouse Down at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if EventStrut.message = WM_RBUTTONDOWN then
       s := 'Right Mouse Down at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if (EventStrut.message = WM_RBUTTONUP) then
       s := 'Right Mouse Up at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if (EventStrut.message = WM_MOUSEWHEEL) then
       s := 'Mouse Wheel at X pos ' +
         IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

     if (EventStrut.message = WM_MOUSEMOVE) then
       s := 'Mouse Position at X:' +
         IntToStr(EventStrut.paramL) + ' and Y: ' + IntToStr(EventStrut.paramH);

     if s <> '' then
       Form1.ListBox1.ItemIndex := Form1.ListBox1.Items.Add(s);
   end;
end;



procedure TForm1.Button_StartJourClick(Sender: TObject);
begin
   if FHookStarted then
   begin
     ShowMessage('Mouse is already being Journaled, can not restart');
     Exit;
   end;
   JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);
   {SetWindowsHookEx starts the Hook}
   if JHook > 0 then
   begin
     FHookStarted := True;
   end
   else
     ShowMessage('No Journal Hook availible');
end;

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

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
   var Handled: Boolean);
begin
   {the journal hook is automaticly camceled if the Task manager
   (Ctrl-Alt-Del) or the Ctrl-Esc keys are pressed, you restart it
   when the WM_CANCELJOURNAL is sent to the parent window, Application}
   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
   {make sure you unhook it if the app closes}
   if FHookStarted then
     UnhookWindowsHookEx(JHook);
end;

end.