如何检测没有焦点的控件中的修饰键更改？答案

【问题标题】：How to detect modifier key change in a control which doesn't have focus?如何检测没有焦点的控件中的修饰键更改？
【发布时间】：2013-11-03 10:51:36
【问题描述】：

背景：

我正在开发一个从TCustomControl 类派生的控件，它可以获取焦点并且里面有一些内部元素。如果用户将光标悬停在这些内部元素上，它们就会突出显示，您可以选择它们、移动它们等等。现在问题来了……

问题：

如果用户持有 CTRL、ALT 或 SHIFT 修饰符，我将使用（假设）聚焦元素执行不同的操作。如果用户悬停元素并按住例如 CTRL 键，我想要更改鼠标光标。非常简单，您只需覆盖KeyDown 和KeyUp 方法并检查它们的Key 参数是否等于VK_CONTROL。在这样的代码中：

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;

即使这不是检查 CTRL 键是否被按下和释放的最佳方法（例如，由于现有的 Shift 状态参数），它仍按预期工作有焦点，甚至可以得到，但是……

我的目标是在用户将鼠标悬停在控件（或者准确地说，是其中的某个元素）并按住时更改鼠标光标。即使我的控件没有焦点，该 CTRL 键也是如此。可以说，所以只需覆盖MouseMove 方法并在那里请求修饰符状态。本来就是这样，但是……

如果用户将鼠标光标停留在我的控件上并按下并释放 CTRL 键会怎样？这不会为我的控件生成任何鼠标移动或按键事件，还是我错了？好吧，所以我的问题很明显......

问题：

如果控件没有焦点并且用户没有用鼠标移动，我如何检测修饰键的变化？我正在考虑这两个选项，但我希望我错过了一些东西：

键盘挂钩 - 可靠，但对我来说看起来有点矫枉过正
使用计时器定期检查修饰符状态 - 我无法忍受延迟

那么，您将如何检测当前未聚焦的控件的修饰键更改？

【问题讨论】：

很明显你的子控件是windowed的。您可以让您的控件的子级通知其父级键盘事件。
@Andreas，对不起，也许我没有正确理解您的评论...如果您的意思是我提到的那些元素，不。它们只是虚拟的。只有一个窗口控件，需要知道鼠标悬停时修改键的变化。但现在我在想。甚至父表单也不需要处于活动状态，因此可能没有比键盘钩子“更好”的解决方案。
似乎您已经知道 2 个解决方案，而且很可能没有更好的解决方案。如果您将通过计时器检查修饰符的状态（仅在鼠标进入/离开事件之间需要计时器）假设每秒 50 次，用户将无法感受到延迟，所以我想它比系统更简单和更稳定-宽键盘挂钩。
@Andrei，你是对的。 20ms 的间隔不会有人注意到。而且我可以在鼠标进入控件并且控件没有聚焦时启用它。键盘钩子真的是矫枉过正。当我写这个问题时，我只是忘记了应用程序不活跃的情况。谢谢大家！

标签： delphi winapi delphi-xe3

【解决方案1】：

如果你的控件没有获得焦点，它自己的按键事件将不会被触发。但是，您可以做的是让您的控件在内部实例化一个私有TApplicationEvents 组件，并使用它的OnMessage 事件来检测从主消息队列中检索到的关键事件，然后再将它们分派给任何控件进行处理。然后，您可以检查鼠标是否在您的控制上（最好使用 GetMessagePos() 而不是 GetCursorPos() 或 Screen.CursorPos 以便在生成消息时获得鼠标坐标，以防它们被延迟）并更新根据需要，您的控件自己的 Cursor 属性（不是 Screen.Cursor 属性）。

【讨论】：

如果另一个应用程序有焦点将不起作用（但可能不是必需的）。
我意识到，为了完整起见，在应用程序（表单）不活动时跟踪这些修饰符更改也是公平的。当我回复 Andreas 的评论时，我很晚才意识到这一点。此解决方案将起作用，但前提是应用程序处于活动状态（聚焦）。我可能会保留计时器，仅当鼠标进入控件并且控件未聚焦时才启用该计时器。正如@Andrei 所说，将间隔设置为 20ms 甚至不会有人注意到。还是谢谢！
@TLama：我什至无法想象如果一个非活动应用程序响应我在另一个应用程序中所做的事情会让人分心。那么我在这里缺少什么？当您的应用程序不活动时响应键盘/鼠标消息的用例是什么？
@MarjanVenema 但是，如果“响应”意味着即使窗口处于非活动状态，也要在鼠标悬停时更改鼠标光标，那么几乎每个 Windows 应用程序都会这样做。
@TLama：我错过了键+鼠标悬停的组合（TOndrej 清除了我的想法）。仍然非常感谢背景信息。您正在开发的有趣应用程序。

【解决方案2】：

我将为WM_SETCURSOR 消息编写一个消息处理程序来调用GetKeyboardState 以获取键盘状态（在Delphi 中，您可以只调用KeyboardStateToShiftState）并基于该结果（和命中测试）调用@ 987654324@ 带有相应的光标。

对于处理WM_SETCURSOR，VCL 中有一个示例：TCustomGrid.WMSetCursor 在Grids 单元中。

【讨论】：

我真的不明白这将如何解决当鼠标悬停在非活动表单上的控件（不移动）上并且用户按下 CTRL 键时的情况。这将如何触发 WM_SETCURSOR 消息或我错过了什么？
@kobik，好吧，它不能解决这种情况（使用非活动形式），其他答案也是如此。但是，在活动形式中，即使对于没有焦点的控件，也会发送此消息，因此它最接近我的需求，也是处理光标更改的正确方法（当鼠标未被捕获时），因此我接受。尽管如此，当表单处于非活动状态时，我仍需要解决这种情况。

【解决方案3】：

Remy 的答案很可能是您的解决方案，但如果您尝试在没有将其封装到控件中的限制的情况下执行此操作并发现自己在这里：

您可以通过三个步骤来处理这个问题，如下所示。

这里的关键是：

设置控件的光标，而不是屏幕的光标
使用表单的KeyPreview 属性
找到光标下的控件

我用一个按钮来说明这个过程。请务必将表单的 KeyPreview 设置为 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;

【讨论】：

例如，如果另一个应用程序处于活动状态/具有焦点，则键盘事件永远不会触发，但 TLama 需要在鼠标悬停控制时随时具有修饰符状态（如果我正确理解任务）。
@kobik，谢谢。我更新了我的答案，而且我意识到 OP 需要将它封装到一个控件中，所以这无论如何都不起作用。
我不知道，我为什么写Screen.Cursor。当然，我只想写Cursor :-) 是的，这可能是开箱即用的解决方案，也仅适用于应用程序集中的情况。抱歉，当我在这里回复第一条评论时，我意识到了这种情况。还是谢谢！

【解决方案4】：

我不知道它是否会比使用钩子更小，但一种选择是使用“raw input”。如果您相应地注册您的控件，它也会在不活动时接收输入。示例实现来决定..：

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;

【讨论】：