How to detect modifier key change in a control which doesn't have focus?

Question

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 ?

Answer 1

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.

Answer 2

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.

Answer 3

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:

1. Set the control's cursor, not the screen's cursor
2. Use the form's KeyPreview property
3. 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;

Answer 4

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;