Delphi,如何显示鼠标移动的叠加控件

时间:2014-01-23 09:08:54

标签: delphi delphi-7 mousemove

我使用Delphi 7并且我有一个TFrame(由TForm托管),其中三个面板跨越整个表面,采用“倒置T”布局。 面板应该可以调整大小,所以我可以使用2个分离器,但我希望提供更好的用户体验:我想在T结中有一个“大小抓握”。 只有当用户悬停交叉区域时,才会出现此“句柄”。

所以这是我的问题:在鼠标移动中,控制节目的最佳方法是什么? TFrame.OnMouseMove不会被调用(显然),因为里面有面板,可能还有其他任何控件。 我也强烈希望将所有代码保留在框架内。

我看到了两个解决方案:

  1. 安装本地鼠标钩并继续使用它。但可能会有一些 性能问题(或不是?)
  2. 处理内部TApplication.OnMessage     框架,但添加一些其他代码,以模拟“链”     事件处理程序。这是因为应用程序的其他部分     可能需要为自己的目的处理TApplication.OnMessage。
  3. 还有其他想法吗?

    谢谢

2 个答案:

答案 0 :(得分:2)

要为整个帧制作一个鼠标移动事件通知程序,无论哪个子控件悬停,您都可以编写WM_SETCURSOR消息的处理程序,就像我从this post中的TOndrej中学到的那样。从这样的事件处理程序中,您可以确定哪个控件悬停并将其置于最前面。

请注意,我在这里做了很常见的错误。不得以这种方式阅读GetMessagePos结果。它甚至在文档中明确提到过。我没有Windows SDK来查看MAKEPOINTS宏,所以我稍后会解决这个问题:

type
  TFrame1 = class(TFrame)
    // there are many controls here; just pretend :-)
  private
    procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  end;

implementation

procedure TFrame1.WMSetCursor(var Msg: TWMSetCursor);
var
  MsgPos: DWORD;
  Control: TWinControl;
begin
  inherited;
  MsgPos := GetMessagePos;
  Control := FindVCLWindow(Point(LoWord(MsgPos), HiWord(MsgPos)));
  if Assigned(Control) then
    Control.BringToFront;
end;

答案 1 :(得分:1)

我会发布这个自我回答只是因为它有效并且在某些情况下它可能有用,但我将TLama标记为最佳答案。
这是问题的解决方案2):

TMyFrame = class(TFrame)
  // ...design time stuff...
private
  FMouseHovering: Boolean;
  FPreviousOnAppMessage: TMessageEvent;
  procedure DoOnAppMessage(var Msg: TMsg; var Handled: Boolean);
protected
  procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
end;


implementation

constructor TMyFrame.Create(AOwner: TComponent);
begin
  inherited;
  FMouseHovering := False;
  FPreviousOnAppMessage := Application.OnMessage;
  Application.OnMessage := DoOnAppMessage;
end;

destructor TMyFrame.Destroy;
begin
  Application.OnMessage := FPreviousOnAppMessage;
  inherited;
end;

procedure TRiascoFrame.CMMouseEnter(var Message: TMessage);
begin
  FMouseHovering := True;
end;

procedure TRiascoFrame.CMMouseLeave(var Message: TMessage);
begin
  FMouseHovering := False;
end;

procedure TMyFrame.DoOnAppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if (Msg.message = WM_MOUSEMOVE) and FMouseHovering then
    DoHandleMouseMove(Msg.hwnd, Integer(LoWord(Msg.lParam)), Integer(HiWord(Msg.lParam)));
  if Assigned(FPreviousOnAppMessage) then
    FPreviousOnAppMessage(Msg, Handled);
end;

procedure TMyFrame.DoHandleMouseMove(hWnd: HWND; X, Y: Integer);
var
  ClientPoint: TPoint;
begin
  ClientPoint := Point(X, Y);
  Windows.ClientToScreen(hwnd, ClientPoint);
  Windows.ScreenToClient(Self.Handle, ClientPoint);
  if PtInRect(ClientRect, ClientPoint) then
  begin
    // ...do something...
  end;
end;