如何将鼠标事件重定向到另一个控件？

Question

我有这样一种情况，我有一个TImage，在它的上方部分覆盖着一个TPanel，它们共享同一个父容器：

------------------
|  Image1        |
|  ------------  |
|  |  Panel1  |  |
|  ------------  |
|                |
------------------

Panel1正在接收鼠标的按下/移动/释放事件并进行处理（Image1也是如此），但在某些情况下，我希望将鼠标按下消息“重定向”到Image1，仿佛是单击了Image1而不是Panel1。

这是我所做的：

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if (ssLeft in Shift) then
    Beep;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; 
  X, Y: Integer);
begin
  //...
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ShowMessage('boo!');
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if FRedirectToImage then begin
    ReleaseCapture; // do I need to send a WM_LBUTTONUP as well to the panel?        
    GetCursorPos(P);
    P := ScreenToClient(P);
    Image1.Perform(WM_LBUTTONDOWN, MK_LBUTTON, Longint(PointToSmallPoint(P)));
    Exit;
  end;

  // Normal handling
  if (ssLeft in Shift) then begin
    // ...
  end;
end;

它按预期工作，但我不确定是否是正确的方法。我的问题是，我是否做得对？是否有更好或推荐的方法？

更新（1）： 如建议的那样处理WM_NCHITTEST是一个有效的答案，我也考虑过它。即使将Panel1.Enabled设置为False也会将鼠标消息路由到底层的Image1控件。

但是（！）请考虑这种情况：当我单击面板上的x位置时，仍然需要将消息路由到Image1：

------------------
|  Image1        |
|          --------------
|          |  Panel1  x |
|          --------------
|                |
------------------

我的方法是可行的，但在描述的情况下不适用WM_NCHITTEST。我仍然没有得到答案，关于我的方法是否有效。(或者也许我应该用上述情况提出另一个问题？)

- Vlad

---

我认为你最好在消息循环层面上实现这个功能。为TApplication实现一个OnMessage处理程序，或者使用TApplicationEvents对象完成相同的操作。在那里，你可以更改感兴趣的消息的目标窗口句柄。 - David Heffernan

@David，从这个问题的第一眼看不出来，但是OP真的想要重定向消息。所以，这就是前进的方式。 - TLama

@TLama，我没有写答案的渴望。请不要因此感到受限制，你可以自己回答！ - David Heffernan

@DavidHeffernan，“我没有在这里写答案的渴望。”为什么呢？ - Vlad

@Vlad 我现在想看电视。我今天已经写了足够的答案了。 - David Heffernan

RE（更新1）：原问题并没有明确说明您希望在鼠标超出图像区域时也能接收到鼠标消息，因此您得到的答案可能不太适合您的需求。另外，在图像区域外部是不应该被点击的，对吧？如果答案符合您的需求，那么禁用面板当然是可以的，前提是您不需要启用的面板。我没有测试过您的代码，因此无法对主要功能进行评论，但它看起来不太对劲——您甚至没有将点转换为图像的坐标。而且，您已经有了一个点（X，Y），不需要使用GetCursorPos。 - Sertac Akyuz

Answer 1

处理发送到面板的 wm_NCHitTest 消息并返回 htTransparent。操作系统将将鼠标消息发送到下一个控件，无需从程序中进一步处理。(从操作系统的角度来看，"下一个控件" 是面板和图像的父控件；VCL 负责将鼠标消息路由回图像控件，就像所有 TGraphicControl 的后代控件一样，因为它们不是真正的窗口化控件)。类似这样：

procedure TParentForm.PanelWindowProc(var Msg: TMessage);
begin
  FPrevPanelWindowProc(Msg);
  if (Msg.Message = wm_NCHitTest) and FRedirectToImage then
    Msg.Result := htTransparent;
end;

将该方法分配给面板的WindowProc方法。 在表单的字段中存储属性的先前值。

var
  FPrevPanelWindowProc: TWndMethod;

FPrevPanelWindowProc := Panel.WindowProc;
Panel.WindowProc := Self.PanelWindowProc;

- Rob Kennedy

Answer 2

如果你想要重定向鼠标事件的控件不在它应该被重定向到的控件的整个客户区域内（就像你在问题更新中所展示的那样），那么WM_NCHITTEST消息可能会被发送到另一个控件。这时，唯一的方法是使用IMHO，重定向所有鼠标消息。

正如@David在他的评论中提到的，你可以通过编写TApplication的OnMessage事件处理程序来全局地进行消息重定向。或者使用TApplicationEvents对象。

在下面的示例中，您可以定义要重定向的消息范围，并指定该重定向的源控件和目标控件列表。重定向使用OnMessage事件的TApplication对象，但由于您的目标在这种情况下是TGraphicControl的后代，因此您不能仅更改传入消息的收件人，而必须通过Perform方法自己吃掉此消息并在目标控件上执行该消息。

以下代码显示如何将Panel1的所有鼠标消息重定向到Image1。如果您想要，可以从此处获取整个测试项目：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TMsgRange = record
    MsgFrom: UINT;
    MsgTo: UINT;
  end;
  TRedirect = record
    Source: HWND;
    Target: TControl;
  end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Panel1: TPanel;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    FRedirectList: array of TRedirect;
    FRedirectEnabled: Boolean;
    FRedirectMsgRange: TMsgRange;
    procedure ApplicationMessage(var AMessage: TMsg; var Handled: Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ApplicationMessage(var AMessage: TMsg; var Handled: Boolean);
var
  I: Integer;
begin
  if FRedirectEnabled and (AMessage.message >= FRedirectMsgRange.MsgFrom) and
    (AMessage.message <= FRedirectMsgRange.MsgTo) then
  begin
    for I := 0 to High(FRedirectList) do
      if (AMessage.hwnd = FRedirectList[I].Source) and
        Assigned(FRedirectList[I].Target) then
      begin
        Handled := True;
        FRedirectList[I].Target.Perform(AMessage.message,
          AMessage.wParam, AMessage.lParam);
        Break;
      end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FRedirectEnabled := True;
  FRedirectMsgRange.MsgFrom := WM_MOUSEFIRST;
  FRedirectMsgRange.MsgTo := WM_MOUSELAST;
  SetLength(FRedirectList, 1);
  FRedirectList[0].Source := Panel1.Handle;
  FRedirectList[0].Target := Image1;
  Application.OnMessage := ApplicationMessage;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Image1MouseDown')
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Image1MouseUp')
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Panel1MouseDown')
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Memo1.Lines.Add('Panel1MouseUp')
end;

end.

- TLama

---

忘记注意，在源控件搜索循环中使用Break（当在重定向列表中找到控件时）只能为一个源控件指定一个重定向。所有其他的都将被忽略。如果您删除该Break，则可以将消息广播到多个目标控件。 - TLama

Answer 3

你可以派生你的面板类来处理WM_NCHITTEST消息，以便为你想让控件位于面板下方接收鼠标消息的区域返回HTTRANSPARENT。例如：

procedure TMyPanel.WMNCHitTest(var Message: TWMNCHitTest);
var
  Pt: TPoint;
begin
  Pt := ScreenToClient(SmallPointToPoint(Message.Pos));
  if (Pt.X < 80) and (Pt.Y < 60) then // devise your logic here...
    Message.Result := HTTRANSPARENT
  else
    inherited;
end;

显然，这只是一个测试。你可以在组件中发布一个字段来解决控件所在的位置等问题。

- Sertac Akyuz