Background:
I'm working on a control derived from TCustomControl
class which can get focus and which has some inner elements inside. Those inner elements are highlighted if the user hovers them with the cursor, you can select them, move them and so on. Now to the problem...
Problem:
I'm doing different actions with the (let's say) focused element if the user holds CTRL, ALT or SHIFT modifiers. What I would like is to change the mouse cursor if the user hovers the element and holds for instance CTRL key. Pretty simple, you just override the KeyDown
and KeyUp
methods and check if their Key
parameter equals to VK_CONTROL
. In code like this way:
procedure TMyCustomControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
inherited;
if Key = VK_CONTROL then
Screen.Cursor := crSizeAll;
end;
procedure TMyCustomControl.KeyUp(var Key: Word; Shift: TShiftState);
begin
inherited;
if Key = VK_CONTROL then
Screen.Cursor := crDefault;
end;
Even if that wouldn't be the best way to check if the CTRL key was pressed and released (e.g. because of the existing Shift
state parameter), it works as expected whe the control has focus, which can even get, but...
My aim is to change the mouse cursor when user hovers the control (or to be precise, a certain element inside it) and holds e.g. that CTRL key even when my control doesn't have focus. One can say, so just override the MouseMove
method and ask for the modifier states there. And it would be the way, but...
What if the user stays with the mouse cursor over my control and press and release that CTRL key ? That won't generate any mouse move nor key press event for my control, or am I wrong ? Well, so my question is quite obvious...
Question:
How can I detect modifier key changes if the control doesn't have focus and the user doesn't move with the mouse ? I was thinking about these two options, but I hope there is something I missed:
- keyboard hook - reliable, but looks quite overkill to me
- periodical check of the modifier states with a timer - I couldn't live with a delay
So, how would you detect modifier key changes of a control which isn't currently focused ?
I would write a message handler for WM_SETCURSOR
message to call GetKeyboardState
to get the keyboard state (in Delphi you can just call KeyboardStateToShiftState) and based on the result of that (and the hit test) call SetCursor
with the appropriate cursor.
For handling WM_SETCURSOR
, there's an example in the VCL: TCustomGrid.WMSetCursor
in the Grids
unit.
If your control is not focused, its own key events will not be triggered. However, what you can do instead is have your control instantiate a private TApplicationEvents
component internally, and use its OnMessage
event to detect key events being retrieved from the main message queue before they are dispatched to any control for processing. You can then check if the mouse is over your control (better to use GetMessagePos()
instead of GetCursorPos()
or Screen.CursorPos
so that you get the mouse coordinates at the time the messages were generated, in case they are delayed) and update your control's own Cursor
property (not the Screen.Cursor
property) as needed.
Remy's answer is likely your solution, but in case you're trying to do this without the restriction of encapsulating it into a control and found yourself here:
You could handle this with a three step process, as I've shown below.
The key things here are:
- Set the control's cursor, not the screen's cursor
- Use the form's
KeyPreview
property
- Find the control under the cursor
I've used a button to illustrate the process. Be sure to set your form's KeyPreview
to True
.
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
myControl: TControl;
begin
// If they pressed CTRL while over the control
if ssCtrl in Shift then
begin
myControl := ControlAtPos(ScreenToClient(Mouse.CursorPos), False, True);
// is handles nil just fine
if (myControl is TButton) then
begin
myControl.Cursor := crSizeAll;
end;
end;
end;
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var
myControl: TControl;
begin
// If they released CTRL while over the control
if not(ssCtrl in Shift) then
begin
myControl := ControlAtPos(ScreenToClient(Mouse.CursorPos), False, True);
if (myControl is TButton) then
begin
myControl.Cursor := crDefault;
end;
end;
end;
procedure TForm1.Button1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
// If they move over the button, consider current CTRL key state
if ssCtrl in Shift then
begin
Button1.Cursor := crSizeAll;
end
else
begin
Button1.Cursor := crDefault;
end;
end;
I can't tell if it would be less overkill than using a hook, but one option would be to use "raw input". If you register your control accordingly, it will receive input also when it's not active. Sample implementation to decide..:
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;