繁体   English   中英

Delphi,如何在鼠标移动时显示重叠控件

[英]Delphi, How to show an overlayed control on mouse move

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

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

我看到2个解决方案:

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

还有其他想法吗?

谢谢

要为整个帧创建鼠标移动事件通知程序,无论哪个子控件被悬停,您都可以为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;

我会发布这个自我回答只是因为它有效并且在某些情况下它可能有用,但我将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;

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM