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 elem

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

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 3

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 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;