避免 SetFocus 引发异常

Question

我正在处理一个巨大的遗留源代码，其中在许多地方调用了多个

SetFocus

，但有时，缺少控件是否可见或启用的检查。

由于时间有限，而且源代码数量巨大，我决定忽略这些错误，因为重点（在我们的例子中）不是关键功能。引发的异常将导致完全失败，而焦点缺失只是一个光学问题。

我目前的计划如下：

1. 我创建了一个带有类助手的单元，如下所示：

   类型 TWinControlEx = TWinControl 的类帮助器 程序SetFocusSafe； 结束；

   过程 TWinControlEx.SetFocusSafe; 开始 如果 CanFocus 则 SetFocus； 结束；

2. 我将该单元包含到使用“.SetFocus”的每个单元中（我将使用全局代码搜索）

3. 我将每个 .SetFocus 替换为 .SetFocusSafe

但有一个问题：如果可能的话，我想避免同事意外使用 .SetFocus ，或者忘记包含 classhelper 单元。

我还有哪些其他选择？

最好的情况是有一种技术/黑客可以使 SetFocus 不引发异常。 （无需重新编译VCL）

Answer 1

只需修补

TWinControl.SetFocus

方法即可：

unit SetFocusFix;

interface

implementation

uses
  Controls,
  Forms,
  SysUtils,
  Windows;

type
  TWinControlHack = class(TWinControl)
  public
    procedure SetFocus; override;
  end;

procedure TWinControlHack.SetFocus;
var
  Parent: TCustomForm;
begin
  if not CanFocus then Exit;

  Parent := GetParentForm(Self);
  if Parent <> nil then
    Parent.FocusControl(Self)
  else if ParentWindow <> 0 then
    Windows.SetFocus(Handle)
  else
    ValidParentForm(Self);
end;

procedure RedirectFunction(OrgProc, NewProc: Pointer);
type
  TJmpBuffer = packed record
    Jmp: Byte;
    Offset: Integer;
  end;
var
  n: UINT_PTR;
  JmpBuffer: TJmpBuffer;
begin
  JmpBuffer.Jmp := $E9;
  JmpBuffer.Offset := PByte(NewProc) - (PByte(OrgProc) + 5);
  if not WriteProcessMemory(GetCurrentProcess, OrgProc, @JmpBuffer, SizeOf(JmpBuffer), n) then
    RaiseLastOSError;
end;

initialization
  RedirectFunction(@TWinControl.SetFocus, @TWinControlHack.SetFocus);

end.

Answer 2

或者

  TWinControlEx = class helper for TWinControl
    procedure SetFocus; reintroduce;
  end;

与...

procedure TWinControlEx.SetFocus;
var
  Parent: TCustomForm;
begin
  if not CanFocus then Exit;
  Parent := GetParentForm(Self);
  if Parent <> nil then
    Parent.FocusControl(Self)
  else if ParentWindow <> 0 then
    Winapi.Windows.SetFocus(Handle)
  else
    ValidParentForm(Self);
end;

Answer 3

我下面的回答并没有直接回答您的问题，但它仍然相关，因为您依赖 CanFocus。 CanFocus 撒了谎。你不应该依赖它。文档也是错误的。更准确地说，即使控件不可聚焦，CanFocus 也可以返回 True。在这种情况下，将会引发异常。

所以，用这个代替：

function CanFocus(Control: TWinControl): Boolean;   
begin
 Result:= Control.CanFocus AND Control.Enabled AND Control.Visible;
 if Result
 AND NOT Control.InheritsFrom(TForm)
 then
   { Recursive call:
     This control might be hosted by a panel, which could be also invisible/disabled.
     So, we need to check all the parents down the road, until we encounter the parent Form.
     Also see: GetParentForm }
   Result:= CanFocus(Control.Parent); { Parent of a control could be nil, but in this case Control.CanFocus will deal with that.}
end;


procedure SetFocus(Control: TWinControl);
begin
 if CanFocus(Control)
 then Control.SetFocus;
end;

PS：在Lazarus下CanFocus工作正常。

2023 年更新

请参阅这篇有关 CanFocus 的新文章以及如何修复它。 您甚至可以找到一个工具，可以用固定函数 SetFocus() 替换所有 Control.SetFocus 方法。

---

理由：

J 提供了一个很好的答案，但我不喜欢类助手，因为如果同一类有多个类助手，则将使用唯一的一个。这个过程几乎是“掷骰子”：“uses”子句中的单元顺序决定了将应用哪个助手。我不喜欢编程语言中如此多的随机性。