delphi - 避免 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.