Question

我正在处理一个巨大的遗留源代码，其中有几个运动调用了SetFocus，但是如果控件可见或已启用则不会检查。

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

我目前的计划如下：

1）我创建了一个带有类助手的单元：

type
  TWinControlEx = class helper for TWinControl
    procedure SetFocusSafe;
  end;

procedure TWinControlEx.SetFocusSafe;
begin
  if CanFocus then SetFocus;
end;

2）我将单位包含在每个使用＆＃34; .SetFocus＆＃34; （我将使用全局代码搜索）

3）我用.SetFocusSafe

替换每个.SetFocus

但是有一个问题：如果可能的话，我想避免那些同事意外地使用.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返回谎言。您不应该依赖其返回值。该文档也是错误的。

因此，请改用它：

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);
end;


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

PS：在Lazarus下，CanFocus正常工作。

避免SetFocus引发异常

3 个答案: