如何让 TImage 和 TLabel 收到 WM_RBUTTONDOWN 消息？

Question

在 Windows 10 的 Delphi 11 32 位 VCL 应用程序中，在运行时，我在按住 SHIFT 和 CTRL 修改键的同时右键单击控件, 将点击的控件名称复制到剪贴板:

procedure TformMain.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
begin
  case Msg.message of
    Winapi.Messages.WM_RBUTTONDOWN:
      begin
        // Detect the name of the clicked control:
        var ThisControl: Vcl.Controls.TWinControl;
        ThisControl := Vcl.Controls.FindControl(Msg.hwnd);
        if Assigned(ThisControl) then
        begin
          var keys: TKeyboardState;
          GetKeyboardState(keys);
          // when right-clicking a control, hold down the SHIFT and CTRL key to escape the possible default click behavior of the control:
          if (keys[VK_SHIFT] and  <> 0) and (keys[VK_CONTROL] and  <> 0) then
          begin
            Handled := True;
            //CodeSite.Send('TformMain.ApplicationEvents1Message: ThisControl.Name', ThisControl.Name);
            Vcl.Clipbrd.Clipboard.AsText := ThisControl.Name;
          end;
        end;
      end;
  end;
end;

这适用于几乎所有控件，除了 Timage 和 TLabel（可能还有一些其他控件类型）。我怎样才能使 Timage 和 TLabel 也能正常工作？

Answer 1

TImage 和 TLabel 来自 TGraphicControl，而不是 TWinControl。他们没有自己的 HWND，这就是 Vcl.Controls.FindControl() 对他们不起作用的原因。您收到的 WM_RBUTTONDOWN 消息属于他们 Parent 的 HWND。在内部，当 VCL 路由消息时，它将考虑图形子控件。但是你的代码不是。

尝试 Vcl.Controls.FindDragTarget() instead. It takes screen coordinates as input (which you can get by translating the client coordinates in WM_RBUTTONDOWN's lParam using Winapi.ClientToScreen() or Winapi.MapWindowPoints())，然后在这些坐标处 returns TControl，因此它适用于窗口和图形控件。

也就是说，在这种情况下您不需要使用 Winapi.GetKeyboardState()，因为 WM_RBUTTONDOWN 的 wParam 会告诉您 SHIFT 和 CTRL 键在生成消息时被按住（记住，您正在处理 queued 消息，所以会有延迟在消息生成时间和您收到消息的时间之间）。

procedure TformMain.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
const
  WantedFlags = MK_SHIFT or MK_CONTROL;
begin
  if Msg.message = WM_RBUTTONDOWN then
  begin
    // Detect the name of the clicked control:
    var Pt: TPoint := SmallPointToPoint(TSmallPoint(Msg.LParam));
    Windows.ClientToScreen(Msg.hwnd, Pt);
    var ThisControl: TControl := FindDragTarget(Pt, True);
    if Assigned(ThisControl) then
    begin
      // when right-clicking a control, hold down the SHIFT and CTRL key to escape the possible default click behavior of the control:
      if (Msg.wParam and WantedFlags) = WantedFlags then
      begin
        Handled := True;
        //CodeSite.Send('TformMain.ApplicationEvents1Message: ThisControl.Name', ThisControl.Name);
        Clipboard.AsText := ThisControl.Name;
      end;
    end;
  end;
end;

如何让 TImage 和 TLabel 收到 WM_RBUTTONDOWN 消息？

How to make TImage and TLabel receive WM_RBUTTONDOWN messages?

delphi

winapi

delphi-11-alexandria