unit umain;
{$mode OBJFPC}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, jwawinuser, windows;
const
BUFFER_LENGTH = 255;
type
{ TForm1 }
TForm1 = class(TForm)
bRegisterDevice: TButton;
cbLeft: TCheckBox;
cbMiddle: TCheckBox;
cbRight: TCheckBox;
Memo1: TMemo;
Panel1: TPanel;
Timer1: TTimer;
procedure bRegisterDeviceClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
function WMInput(wParam: WParam; lParam: LParam):LRESULT;
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
var
PrevWndProc:windows.WNDPROC;
function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam;
lParam: LParam): LRESULT; stdcall;
// replace the message loop in order to handle the WM_INPUT message
begin
case uMsg of
WM_INPUT:
begin
// Form1.Memo1.Lines.Add('Beep');
result := Form1.WMInput(wParam,lParam);
// result := DefWindowProc(Ahwnd,uMsg,wParam,LParam);
end;
end;
// if the message is not a WM_INPUT, then call the default message loop to handle it
Result := CallWindowProc(PrevWndProc, Ahwnd, uMsg, WParam, LParam);
end;
{ TForm1 }
function TForm1.WMInput(wParam: WParam; lParam: LParam):LRESULT;
var
// pBuffer : ^RAWINPUT;
pBuffer : ^char;
lwBufferLength: LongWord;
iBytesCopied: integer;
cButtonStatus: char;
begin
Result := 0;
Memo1.Lines.Add('WM_INPUT');
Memo1.Lines.Add('LParam : ' + IntToStr(LParam));
Memo1.Lines.Add('WParam : ' + IntToStr(WParam));
lwBufferLength := SizeOf(RAWINPUTHEADER);
// if GetRawInputData(hToRawInput,RID_INPUT,pBuffer,lwBufferLength,0) <> 0 then
if GetRawInputData(HRAWINPUT(lParam),RID_INPUT,NIL,lwBufferLength,SizeOf(RAWINPUTHEADER)) <> 0 then
begin
Memo1.Lines.Add('Error Getting Buffer Size GetRawInputData(hToRawInput,RID_HEADER,pBuffer,lwBufferLength,0)');
exit;
end;
Memo1.Lines.Add('Header Buffer Size is ' + IntToStr(lwBufferLength));
GetMem(pBuffer,lwBufferLength);
try
iBytesCopied := GetRawInputData(HRAWINPUT(lParam),RID_INPUT,pBuffer,lwBufferLength,SizeOf(RAWINPUTHEADER));
Memo1.Lines.Add('Bytes Copied : ' + IntToStr(iBytesCopied));
if iBytesCopied < 1 then
begin
Memo1.Lines.Add('Error Getting Header GetRawInputData(hToRawInput,RID_HEADER,pBuffer,lwBufferLength,0)');
exit;
end;
cButtonStatus := (pBuffer+25)^;
Memo1.Lines.Add('Button Status: ' + IntToStr(integer(cButtonStatus)));
if (integer(cButtonStatus) and 1) <> 0 then
cbLeft.checked := true
else
cbLeft.checked := false;
if (integer(cButtonStatus) and 2) <> 0 then
cbMiddle.checked := true
else
cbMiddle.checked := false;
if (integer(cButtonStatus) and 4) <> 0 then
cbRight.checked := true
else
cbRight.checked := false;
finally
FreeMem(pBuffer);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
PrevWndProc:=Windows.WNDPROC(SetWindowLongPtr(Self.Handle,GWL_WNDPROC,PtrInt(@WndCallback)));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
// Don't need to do anything, just having an event is enough to cause the
// wm_input messages to be received.
end;
procedure TForm1.bRegisterDeviceClick(Sender: TObject);
var
nDevices : LongWord;
listentries : Array of RAWINPUTDEVICELIST;
i : integer;
pBuffer : ^char;
lwBufferLength: LongWord;
iReturnedByteCount:integer;
pRID_DEVICE_INFO : ^RID_DEVICE_INFO;
lwRID_DEVICE_INFO_Length : LongWord;
pRAWINPUTDEVICE : ^RAWINPUTDEVICE;
begin
lwBufferLength := BUFFER_LENGTH; // use a hardcoded length here because it's an easy way to handle the string for the device name (length not known ahead of time).
GetMem(pBuffer,lwBufferLength);
lwRID_DEVICE_INFO_Length := sizeof(RID_DEVICE_INFO);
Memo1.Lines.Add('lwRID_DEVICE_INFO_Length : ' + IntToStr(lwRID_DEVICE_INFO_Length));
GetMem(pRID_DEVICE_INFO, lwRID_DEVICE_INFO_Length);
Memo1.Lines.Add('get information about list');
if (GetRawInputDeviceList(nil, nDevices, sizeof(RAWINPUTDEVICELIST)) = 0) then
begin
Memo1.Lines.Add('found ' + IntToStr(nDevices) + ' devices');
Memo1.Lines.Add('Set size of list');
SetLength(listentries, nDevices);
if (GetRawInputDeviceList(@ListEntries[0], nDevices, sizeof(RAWINPUTDEVICELIST)) <> LongWord(-1) ) then
begin
for i := low(ListEntries) to High(ListEntries) do
begin
Memo1.Lines.Add('Line = ' + IntToStr(i) + ' handle = ' + IntToStr(listentries[i].hDevice) + ' Type = ' + IntToStr(listentries[i].dwType));
case listentries[i].dwType of
RIM_TYPEHID: Memo1.Lines.Add('Other');
RIM_TYPEKEYBOARD: Memo1.Lines.Add('Keyboard');
RIM_TYPEMOUSE: Memo1.Lines.Add('Mouse');
end;
iReturnedByteCount := GetRawInputDeviceInfo(listentries[i].hDevice,RIDI_DEVICENAME,pBuffer,lwBufferLength);
if (iReturnedByteCount < 1) then
begin
Memo1.Lines.Add('Error: Buffer too small : RIDI_DEVICENAME');
exit;
end;
Memo1.Lines.Add(pBuffer + ' : ' + IntToStr(iReturnedByteCount));
iReturnedByteCount := GetRawInputDeviceInfo(listentries[i].hDevice,RIDI_DEVICEINFO,pRID_DEVICE_INFO,lwRID_DEVICE_INFO_Length);
if (iReturnedByteCount < 1) then
begin
Memo1.Lines.Add('Error: Buffer to small : RIDI_DEVICEINFO');
exit;
end;
Memo1.Lines.Add('RID_DEVICE_INFO size : ' + IntToStr(pRID_DEVICE_INFO^.cbSize));
case pRID_DEVICE_INFO^.dwType of
RIM_TYPEHID:
begin
Memo1.Lines.Add('dwType : RIM_TYPEHID');
Memo1.Lines.Add('dwVendorId : ' + IntToStr(pRID_DEVICE_INFO^.hid.dwVendorId));
Memo1.Lines.Add('dwProductId : ' + IntToStr(pRID_DEVICE_INFO^.hid.dwProductId));
Memo1.Lines.Add('dwVersionNumber : ' + IntToStr(pRID_DEVICE_INFO^.hid.dwVersionNumber));
Memo1.Lines.Add('usUsagePage : ' + IntToStr(pRID_DEVICE_INFO^.hid.usUsagePage));
Memo1.Lines.Add('usUsage : ' + IntToStr(pRID_DEVICE_INFO^.hid.usUsage));
end;
RIM_TYPEKEYBOARD:
begin
Memo1.Lines.Add('dwType : RIM_TYPEKEYBOARD');
end;
RIM_TYPEMOUSE:
begin
Memo1.Lines.Add('dwType : RIM_TYPEMOUSE');
end;
end;
if listentries[i].dwType = RIM_TYPEHID then
if pRID_DEVICE_INFO^.hid.dwVendorId = 1523 then // vendor id for infinity
if pRID_DEVICE_INFO^.hid.dwProductId = 255 then // product id for usb foot pedal
begin
Memo1.Lines.Add('******************************************');
Memo1.Lines.Add('Found It');
Memo1.Lines.Add('******************************************');
GetMem(pRAWINPUTDEVICE,sizeof(RAWINPUTDEVICE));
pRAWINPUTDEVICE^.usUsagePage := pRID_DEVICE_INFO^.hid.usUsagePage;
pRAWINPUTDEVICE^.usUsage := pRID_DEVICE_INFO^.hid.usUsage;
pRAWINPUTDEVICE^.dwFlags := 0;
pRAWINPUTDEVICE^.hwndTarget := self.Handle;
if not RegisterRawInputDevices(pRAWINPUTDEVICE,1,sizeof(RAWINPUTDEVICE))then
begin
Memo1.Lines.Add('Failed To Register HID');
exit;
end;
FreeMem(pRAWINPUTDEVICE);
break;
end;
Memo1.Lines.Add(' ');
end;
end
else Memo1.Lines.Add('error retreiving the list');
SetLength(listentries, 0);
end
else Memo1.Lines.Add('error');
FreeMem(pBuffer);
FreeMem(pRID_DEVICE_INFO);
end;
end.