{
==============================================================================
Copyright (C) 2006  anir (anir<AT>k.ro)

Modified 2010 - Mark Cranness:
- Work on Windows 7 when pointer speed < 6/11 or 'Enhance pointer precision' is set.
- Better matching of mouse movements to cursor movements.
- MUCH lower CPU use.
- Compiles with freepascal 2.4 http://www.freepascal.org/
	Command line to compile: fpc -Sd MouseMovementRecorder

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
==============================================================================
}

{$apptype console}
{$r MouseMovementRecorder.rc}  // Avoid 'DPI Virtualisation' + Version info

uses
	SysUtils,
	Windows,
	DirectInput; // http://www.clootie.ru/delphi/DX92/Clootie_DirectX92.exe
	// Unrar and copy DirectInput.pas & DXTypes.pas from the Borland_D6-7\ folder 
	// to same folder as MouseMovementRecorder.pas

const
	Caption = 'DEVICE MOVEMENT   CURSOR MOVEMENT   FREQUENCY' + #13;
	ErrMsg1 = 'ERROR: GetCursorPos';
	ErrMsg2 = 'ERROR: QueryPerformanceCounter';

var
	DIMouDev: IDirectInputDevice8;
	DIMouDat: DIMouseState;
	hMouseEvent: HANDLE;
	ConHdl, ErrHdl, TmpLwd: longword;
	OldPos, CurPos: TPoint;
	CursorX, CursorY: integer;
	PrfFrq, OldCnt, PrfCnt: Int64;
	PtrCatchup : Int64;
	MouseFrq, MaxMouseFrq: integer;

label
	Loop;

procedure ErrMsg(ErrMsg: string);
begin
	SetConsoleTextAttribute(ConHdl, FOREGROUND_RED or FOREGROUND_INTENSITY);
	WriteFile(ConHdl, ErrMsg[1], Length(ErrMsg), TmpLwd, Nil);
	SetConsoleTextAttribute(ConHdl, FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED);
end;

function InitDI: Boolean;
var
	DInput: IDirectInput8;
begin
	hMouseEvent := CreateEvent(Nil, True, False, Nil);
	Result := (DirectInput8Create(hInstance, DIRECTINPUT_VERSION, IID_IDirectInput8, DInput, Nil) = DI_OK)
		  and (DInput.CreateDevice(GUID_SysMouse, DIMouDev, Nil) = DI_OK)
		  and (DIMouDev.SetDataFormat(c_dfDIMouse) = DI_OK)
		  and (DIMouDev.SetEventNotification(hMouseEvent) = DI_OK);
end;

begin

	// Output goes to the console (text)
	SetConsoleTitle('Mouse Movement Recorder');
	ConHdl := GetStdHandle(STD_OUTPUT_HANDLE);
	if ConHdl = INVALID_HANDLE_VALUE then begin
		ErrMsg('ERROR: GetStdHandle');
		Exit;
	end;
	// Caption goes to stderr, so it does not end up in a file if we '>' redirect the output
	ErrHdl := GetStdHandle(STD_ERROR_HANDLE);
	if ErrHdl = INVALID_HANDLE_VALUE then begin
		ErrMsg('ERROR: GetStdHandle');
		Exit;
	end;
	SetConsoleMode(ConHdl, ENABLE_PROCESSED_OUTPUT);
	SetConsoleMode(ErrHdl, ENABLE_PROCESSED_OUTPUT);

	// Initialise
	if not InitDI then begin
		ErrMsg('ERROR: DirectInputCreate');
		Exit;
	end;
	if not QueryPerformanceFrequency(PrfFrq) then begin
		ErrMsg('ERROR: QueryPerformanceFrequency');
		Exit;
	end;
	if not QueryPerformanceCounter(OldCnt) then begin
		ErrMsg(ErrMsg2);
		Exit;
	end;
	if DIMouDev.Acquire <> DI_OK then begin
		ErrMsg('ERROR: DirectInput.Acquire');
		Exit;
	end;
	if not GetCursorPos(OldPos) then begin
		ErrMsg(ErrMsg1);
		Exit;
	end;
	SetConsoleTextAttribute(ConHdl, FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED);
	WriteFile(ConHdl, (Caption + #10)[1], Length(Caption)+1, TmpLwd, Nil);
	MaxMouseFrq := 0;
	
	Loop:
	
	// Get raw mouse data
	WaitForSingleObject(hMouseEvent, INFINITE);
	if DIMouDev.GetDeviceState(SizeOf(DIMouDat), @DIMouDat) <> DI_OK then begin
		ErrMsg('ERROR: DirectInput.GetDeviceState');
		Exit;
	end;
	ResetEvent(hMouseEvent);
	if not QueryPerformanceCounter(PrfCnt) then begin
		ErrMsg(ErrMsg2);
		Exit;
	end;

	// Now wait for the pointer to catchup (it might not if the acceleration < 1)
	repeat
		// Get accelerated cursor (pointer) movement
		if not GetCursorPos(CurPos) then begin
			ErrMsg(ErrMsg1);
			Exit;
		end;
		if (CurPos.X <> OldPos.X) Or (CurPos.Y <> OldPos.Y) then
			// Pointer position changed
			break;
		if not QueryPerformanceCounter(PtrCatchup) then begin
			ErrMsg(ErrMsg2);
			Exit;
		end;
		if (PtrCatchup-PrfCnt)*MaxMouseFrq*2 > PrfFrq then
			// >1/2 mouse bus update period
			break;
		// Don't be greedy during a busy wait
		Sleep(0);
	until False;
	
	// Calculate pointer movement based on old position
	CursorX := CurPos.X - OldPos.X;
	CursorY := CurPos.Y - OldPos.Y;
	OldPos := CurPos;

	// Display raw mouse data
	WriteFile(ConHdl, (IntToStr(DIMouDat.lX) + ' x ' + IntToStr(DIMouDat.lY)
			  + '             ')[1], 18, TmpLwd, Nil);

	// Display accelerated "Enhance pointer precision" movement
	if (DIMouDat.lX <> CursorX) or (DIMouDat.lY <> CursorY) then begin
		if CursorX*CursorX + CursorY*CursorY > DIMouDat.lX*DIMouDat.lX + DIMouDat.lY*DIMouDat.lY then
			// Positive acceleration has a RED visual cue
			SetConsoleTextAttribute(ConHdl,
				FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED or BACKGROUND_RED)
		else
			// Negative acceleration (precision) has a GREEN visual cue
			SetConsoleTextAttribute(ConHdl,
				FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED or BACKGROUND_GREEN);
	end;
	WriteFile(ConHdl, (IntToStr(CursorX) + ' x ' + IntToStr(CursorY)
			  + '            ')[1], 17, TmpLwd, Nil);
	SetConsoleTextAttribute(ConHdl, FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED);

	// Display estimated mouse bus update frequency
	MouseFrq := Round(PrfFrq / (PrfCnt - OldCnt));
	if MouseFrq > MaxMouseFrq then MaxMouseFrq := MouseFrq;
	OldCnt := PrfCnt;
	WriteFile(ConHdl, (' ~ ' + IntToStr(MouseFrq) + ' Hz   ')[1], 10, TmpLwd, Nil);
	WriteFile(ConHdl, (#13#10)[1], 2, TmpLwd, Nil);

	// Display legend/caption at bottom
	WriteConsoleA(ErrHdl, @Caption[1], Length(Caption), TmpLwd, Nil);
	
	// Rinse and repeat (use Ctrl+C or Ctrl+Break to stop program)
	goto Loop;
	
end.