1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
| type
TMyCustomControl = class(TCustomControl)
..
protected
..
procedure CreateWindowHandle(const Params: TCreateParams); override;
procedure WMInput(var Message: TMessage); message WM_INPUT;
..
end;
uses
types;
type
tagRAWINPUTDEVICE = record
usUsagePage: USHORT;
usUsage: USHORT;
dwFlags: DWORD;
hwndTarget: HWND;
end;
RAWINPUTDEVICE = tagRAWINPUTDEVICE;
TRawInputDevice = RAWINPUTDEVICE;
PRawInputDevice = ^TRawInputDevice;
LPRAWINPUTDEVICE = PRawInputDevice;
PCRAWINPUTDEVICE = PRawInputDevice;
function RegisterRawInputDevices(
pRawInputDevices: PCRAWINPUTDEVICE;
uiNumDevices: UINT;
cbSize: UINT): BOOL; stdcall; external user32;
const
GenericDesktopControls: USHORT = 01;
Keyboard: USHORT = 06;
RIDEV_INPUTSINK = $00000100;
procedure TMyCustomControl.CreateWindowHandle(const Params: TCreateParams);
var
RID: TRawInputDevice;
begin
inherited;
RID.usUsagePage := GenericDesktopControls;
RID.usUsage := Keyboard;
RID.dwFlags := RIDEV_INPUTSINK;
RID.hwndTarget := Handle;
Win32Check(RegisterRawInputDevices(@RID, 1, SizeOf(RID)));
end;
type
HRAWINPUT = THandle;
function GetRawInputData(
hRawInput: HRAWINPUT;
uiCommand: UINT;
pData: LPVOID;
var pcbSize: UINT;
cbSizeHeader: UINT): UINT; stdcall; external user32;
type
tagRAWINPUTHEADER = record
dwType: DWORD;
dwSize: DWORD;
hDevice: THandle;
wParam: WPARAM;
end;
RAWINPUTHEADER = tagRAWINPUTHEADER;
TRawInputHeader = RAWINPUTHEADER;
PRawInputHeader = ^TRawInputHeader;
tagRAWKEYBOARD = record
MakeCode: USHORT;
Flags: USHORT;
Reserved: USHORT;
VKey: USHORT;
Message: UINT;
ExtraInformation: ULONG;
end;
RAWKEYBOARD = tagRAWKEYBOARD;
TRawKeyboard = RAWKEYBOARD;
PRawKeyboard = ^TRawKeyboard;
LPRAWKEYBOARD = PRawKeyboard;
//- !!! bogus declaration below, see winuser.h for the correct one
tagRAWINPUT = record
header: TRawInputHeader;
keyboard: TRawKeyboard;
end;
//-
RAWINPUT = tagRAWINPUT;
TRawInput = RAWINPUT;
PRawInput = ^TRawInput;
LPRAWINPUT = PRawInput;
const
RIM_INPUT = 0;
RIM_INPUTSINK = 1;
RID_INPUT = $10000003;
RIM_TYPEKEYBOARD = 1;
RI_KEY_MAKE = 0;
RI_KEY_BREAK = 1;
procedure TMyCustomControl.WMInput(var Message: TMessage);
var
Size: UINT;
Data: array of Byte;
RawKeyboard: TRawKeyboard;
begin
if (Message.WParam and $FF) in [RIM_INPUT, RIM_INPUTSINK] then
inherited;
if not Focused and
(WindowFromPoint(SmallPointToPoint(SmallPoint(GetMessagePos))) = Handle) and
(GetRawInputData(Message.LParam, RID_INPUT, nil, Size,
SizeOf(TRawInputHeader)) = 0) then begin
SetLength(Data, Size);
if (GetRawInputData(Message.LParam, RID_INPUT, Data, Size,
SizeOf(TRawInputHeader)) <> UINT(-1)) and
(PRawInput(Data)^.header.dwType = RIM_TYPEKEYBOARD) then begin
RawKeyboard := PRawInput(Data)^.keyboard;
if (RawKeyboard.VKey = VK_CONTROL) then begin
if RawKeyboard.Flags and RI_KEY_BREAK = RI_KEY_BREAK then
Cursor := crDefault
else
Cursor := crSizeAll; // will call continously until key is released
end;
// might opt to reset the cursor regardless of pointer position...
if (RawKeyboard.VKey = VK_MENU) then begin
....
end;
end;
end;
end; |
Partager