鼠标悬在Form上吗?

时间:2010-12-14 10:36:10

标签: delphi pascal

在Delphi XE上,此代码对我不起作用:

http://delphi.about.com/cs/adptips2000/a/bltip0800_5.htm

procedure TForm1.FormDeactivate(Sender: TObject) ;
begin
   ReleaseCapture;
end;

procedure TForm1.FormMouseMove
(Sender: TObject; Shift: TShiftState; X,Y: Integer) ;
begin
  If GetCapture = 0 then
    SetCapture(Form1.Handle) ;
    if PtInRect(Rect(Form1.Left,
                    Form1.Top,
                    Form1.Left + Form1.Width,
                    Form1.Top + Form1.Height),
                    ClientToScreen(Point(x, y))) then
     Form1.Caption := 'Mouse is over form' else
     Form1.Caption := 'Mouse is outside of form';
end;

没有错误 - 它只是没有效果。

请帮忙。

编辑1

事实证明问题不在于代码,即使鼠​​标FormMouseEnter和FormMouseLeave也无法正常工作,因为我将表单传递给我用这样的函数创建的单元:

程序Slide(Form:TForm; Show:Boolean);

我正在从此过程中调用Show方法。我怎样才能克服这个问题?

感谢。

编辑2

我不想使用我现在发布的功能。我想使用下面人们建议的内容(FormMouseEnter和FormMouseLeave),但它也不适用于我的情况。

4 个答案:

答案 0 :(得分:5)

您可以使用OnMouseEnterOnMouseLeave事件来跟踪鼠标是否在表单上,​​而不捕获鼠标光标。

答案 1 :(得分:3)

这只是在相应表单的OnMouseEnter和OnMouseLeave事件中输入必要的代码。就我而言,我所做的只是:

在Delphi中创建一个新项目
选择您正在使用的表格
转到对象检查器
如有必要,切换到对象检查器中的“事件”选项卡 向下滚动到OnMouseEnter事件,双击它旁边的空白区域,这将生成一个EventHandler。确保在事件处理程序中最终得到以下代码:

procedure TForm1.FormMouseEnter(Sender: TObject);
begin
  Self.Caption := 'Mouse in form';
end;

再次转到Object Inspector 找到OnMouseLeave事件并双击其右侧的白色区域以生成新的事件处理程序,并将以下代码添加到其中

procedure TForm1.FormMouseLeave(Sender: TObject);
begin
  Self.Caption := 'Mouse outside form';
end;

运行应用程序...将鼠标移到表单上,标题将更改为“鼠标内部表单”,将其移到表单外部,标题将显示“鼠标外部表单”

作为魅力(在Delphi 2010中测试)

答案 2 :(得分:1)

据我了解,使用SetCapture是一个坏主意。如果它像您希望的那样运行,那么您就会因为不知道更好的跟踪鼠标的方法而抢劫其他所有鼠标消息。

但是MSDN说(http://msdn.microsoft.com/en-us/library/ms646262(VS.85).aspx)即使使用SetCapture,来自外部的鼠标消息也不会被重定向到你的窗口,除非鼠标按钮关闭(可能是一个措施,以防止你想要实现的目标:没有正当理由窃取鼠标)。

你从哪里调用Show()并不重要,所以问题不在于此。

答案 3 :(得分:0)

我需要一个带有大量修改标题的表单(frmTasks)。所以我创建了一个带有隐藏标题的表单。我使用TImage(imgRedLogo)模拟Caption,我在其上绘制了我需要的东西。 此代码允许用户单击假标题(图像)并移动表单。像魅力一样工作,无需捕捉鼠标。即使使用鼠标右键也可以工作(如果你想禁用这个'功能',你必须测试imgRedLogoMouseDown中的'Button'参数。)

完整的工作代码:

VAR
  Dragged  : Boolean= FALSE;
  IsOverImg: Boolean= FALSE;  { True if mouse if over the image }
  OldPos   : TPoint;

procedure TfrmTasks.imgRedLogoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 Dragged:= True;
 GetCursorPos(OldPos);
end;

procedure TfrmTasks.imgRedLogoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
VAR NewPos: TPoint;
begin
 if Dragged AND IsOverImg then
  begin
    GetCursorPos(NewPos);
    frmTasks.Left:= frmTasks.Left- OldPos.X + NewPos.X;
    frmTasks.Top := frmTasks.Top - OldPos.Y + NewPos.Y;
    OldPos:= NewPos;
  end;
end;

procedure TfrmTasks.imgRedLogoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if Dragged
 then Dragged:= False;
end;

procedure TfrmTasks.imgRedLogoMouseEnter(Sender: TObject);
begin
 IsOverImg:= TRUE;
end;

procedure TfrmTasks.imgRedLogoMouseLeave(Sender: TObject);
begin
 IsOverImg:= FALSE;
end;

享受。