我需要的信息与"如何获得控件上的光标位置"这个问题相反。
给定当前光标位置,我如何找到表单(在我的应用程序中)和光标当前所在的控件?我需要它的句柄,这样我才能使用Windows.SetFocus(Handle)
。
作为参考,我使用Delphi 2009。
我在使用建议的解决方案(Delphi XE6/Windows 8.1/x64)时遇到了一些问题:
- FindVCLWindow不搜索禁用控件(Enabled=False)。
- TWinControl。如果控件被禁用,controllatpos不会搜索它们间接地(例如如果按钮)。
在我的情况下,这是一个问题,因为我需要在鼠标光标下找到任何可见的控制,所以我必须使用我自己的功能FindControlAtPos
实现:
function FindSubcontrolAtPos(AControl: TControl; AScreenPos, AClientPos: TPoint): TControl;
var
i: Integer;
C: TControl;
begin
Result := nil;
C := AControl;
if (C=nil) or not C.Visible or not TRect.Create(C.Left, C.Top, C.Left+C.Width, C.Top+C.Height).Contains(AClientPos) then
Exit;
Result := AControl;
if AControl is TWinControl then
for i := 0 to TWinControl(AControl).ControlCount-1 do
begin
C := FindSubcontrolAtPos(TWinControl(AControl).Controls[i], AScreenPos, AControl.ScreenToClient(AScreenPos));
if C<>nil then
Result := C;
end;
end;
function FindControlAtPos(AScreenPos: TPoint): TControl;
var
i: Integer;
f,m: TForm;
p: TPoint;
r: TRect;
begin
Result := nil;
for i := Screen.FormCount-1 downto 0 do
begin
f := Screen.Forms[i];
if f.Visible and (f.Parent=nil) and (f.FormStyle<>fsMDIChild) and
TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(AScreenPos)
then
Result := f;
end;
Result := FindSubcontrolAtPos(Result, AScreenPos, AScreenPos);
if (Result is TForm) and (TForm(Result).ClientHandle<>0) then
begin
WinAPI.Windows.GetWindowRect(TForm(Result).ClientHandle, r);
p := TPoint.Create(AScreenPos.X-r.Left, AScreenPos.Y-r.Top);
m := nil;
for i := TForm(Result).MDIChildCount-1 downto 0 do
begin
f := TForm(Result).MDIChildren[i];
if TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(p) then
m := f;
end;
if m<>nil then
Result := FindSubcontrolAtPos(m, AScreenPos, p);
end;
end;
我认为FindVCLWindow
将满足您的需求。在光标下有了窗口控件之后,您可以遍历父链以查找窗口所在的窗体。
如果您想知道窗体内的控件位于某个x,y坐标
使用function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean;
AllowWinControls: Boolean = False; AllLevels: Boolean = False): TControl;
考虑到您似乎只对应用程序中的表单感兴趣,您可以查询所有表单。
获得非nil结果后,可以使用如下代码查询控件的句柄
伪代码
function HandleOfControlAtCursor: THandle;
const
AllowDisabled = true;
AllowWinControls = true;
AllLevels = true;
var
CursorPos: TPoint
FormPos: TPoint;
TestForm: TForm;
ControlAtCursor: TControl;
begin
Result:= THandle(0);
GetCursorPos(CursorPos);
for each form in my application do begin
TestForm:= Form_to_test;
FormPos:= TestForm.ScreenToClient(CursorPos);
ControlAtCursor:= TestForm.ControlAtPos(FormPos, AllowDisabled,
AllowWinControls, AllLevels);
if Assigned(ControlAtCursor) then break;
end; {for each}
//Break re-enters here
if Assigned(ControlAtCursor) then begin
while not(ControlAtCursor is TWinControl) do
ControlAtCursor:= ControlAtCursor.Parent;
Result:= ControlAtCursor.Handle;
end; {if}
end;
如果你愿意,这也允许你排除某些形式。如果你在寻找简单,我会和大卫一起使用FindVCLWindow
。
注:就我个人而言,我会使用goto
而不是break,因为使用goto可以立即明确break重新进入的位置,但在这种情况下,这不是一个大问题,因为break和重新进入点之间没有语句。
我曾参与过一个大型项目,该项目有许多框架和许多动态创建的控件。当软件运行时,很难弄清楚哪个控件是哪个控件,以及它是在哪里创建的。所以,我写了一小段代码告诉你哪个控件在鼠标下面。我只在程序在调试模式下编译时才显示Digger表单,因此它对客户不可用,而只对开发人员可用。
代码非常非常简单。这一切都恢复到一个名为ShowParentTree的递归函数。我们开始从Digg调用ShowParentTree,它在应用程序空闲时被调用:
procedure TfrmDigger.ApplicationEventsIdle(Sender: TObject; var Done: Boolean);
begin
Digg;
end;
Digg函数看起来是这样的。魔术是由FindVCLWindow:
完成的procedure TfrmDigger.Digg;
VAR Ctrl : TWinControl;
begin
Ctrl := FindVCLWindow(Mouse.CursorPos); { It will not “see” disabled controls }
if Ctrl <> NIL then
begin
VAR s:= ctrl.Name+ ‘ (‘+ ctrl.ClassName + ‘)’;
Memo.Text:= s+ #13#10+ ShowParentTree(ctrl, 1);
Caption := s;
if ctrl is TLabeledEdit then
Caption := Caption + ‘ Text: ‘+TLabeledEdit(ctrl).Text;
end;
end;
一旦我们得到了鼠标下的控件,ShowParentTree通过对自身的递归调用来挖掘该控件的父元素,以及父元素的父元素等等:
function ShowParentTree(Control: TControl; Depth: Integer): string; { Recursive }
VAR Ctrl: TControl;
begin
Ctrl:= Control.Parent;
if Ctrl = NIL
then Result:= ”
else
begin
Result:= System.StringOfChar(‘ ‘, Depth);
Inc(Depth);
Result:= Result+ ‘ ‘+ Ctrl.Name + ‘ (‘+ Ctrl.ClassName+ ‘)’+ #13#10+ ShowParentTree(Ctrl, Depth); { Recursive }
end;
end;
一旦深入到表单,就离开递归调用。
_
一个警告:禁用的控件无法找到/调查,但FindDragTarget将解决这个问题。