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

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控件.

但是(!)考虑这种情况,我单击xPanel上的位置,仍然需要将消息路由到Image1:

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

我的方法有效,但WM_NCHITTEST不适用于所描述的场景.如果我的方法有效,我仍然没有得到答案.(或者我可以用上面的场景问另一个问题？)

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;

Answer 2

如果您要从中重定向鼠标事件的控件将不在其应重定向的控件内的整个客户区域中(如您在问题更新中所示),则WM_NCHITTEST可能会将消息发送到另一个控制.然后唯一的方法仍然是使用恕我直言,重定向所有鼠标消息.

作为@大卫在他的评论中提到的,你可以通过编写一个事件处理程序做一个全球性的方式这条消息重定向OnMessage事件TApplication.或者使用一个TApplicationEvents对象.

在以下示例中,您可以定义将重定向的消息范围,以及指定该重定向的源和目标控件列表.对于重定向使用对象的OnMessage事件TApplication,但由于您的目标是在这种情况下的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.

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;

显然,这只是一个测试,您可以在组件中发布一个字段,以便解析该控件所在的位置等.