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

【问题标题】：How to redirect mouse events to another control?如何将鼠标事件重定向到另一个控件？
【发布时间】：2012-12-13 20:26:46
【问题描述】：

我有一个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 不适用于所描述的场景。如果我的方法有效与否，我仍然没有得到答案。（或者也许我应该对上述情况提出另一个问题？）

【问题讨论】：

我想说最好的办法是在消息循环级别执行此操作。为TApplication 实现OnMessage 处理程序。或者也许对 TApplicationEvents 对象做同样的事情。在那里您可以更改感兴趣消息的目标窗口句柄。
@David，从这个问题的第一个视图中看不到它，但 OP 真的想重定向消息。所以，这就是要走的路。
@TLama 我不想在这里写答案。请不要为自己这样做而感到压抑！
@DavidHeffernan，“我不想在这里写答案”。这是为什么呢？
RE (update1)：最初的问题并不清楚，即使鼠标不在图像区域内，您也需要鼠标消息，因此您得到了答案。另外，在图像区域之外，不应该单击图像，不是吗？如果它们适合您的需求，答案会更好。如果您不需要启用的面板，则禁用面板肯定没问题。我没有测试你的代码，所以我不能评论主要功能，但它看起来不太正确——你甚至没有将点转换为图像的坐标。而且你已经在 (X, Y) 中有一个点，不需要 GetCursorPos。

标签： delphi delphi-7

【解决方案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;

【讨论】：

【解决方案2】：

如果您要从中重定向鼠标事件的控件不在其整个客户区内部这些事件应重定向到的控件（如您在问题中所示更新），那么WM_NCHITTEST 消息可能会被发送到另一个控件。那么唯一的方法仍然是使用恕我直言，重定向所有鼠标消息。

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

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

这里是显示如何将所有鼠标消息从Panel1 重定向到Image1 的代码。如果需要，您可以获取整个测试项目from here：

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.

【讨论】：

忘了注意，由于在源代码管理搜索循环中使用了Break（当在重定向列表中找到该控件时），一个源代码管理只能指定一个重定向。所有其他将被忽略。如果您删除该Break，您将能够将消息广播到多个目标控件。

【解决方案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;

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

【讨论】：