delphi 避免SetFocus引发Exception

dba5bblo  于 2023-04-11  发布在  其他
关注(0)|答案(3)|浏览(195)

我正在处理一个巨大的遗留源代码,其中在许多地方调用了几个SetFocus,但有时,检查控件是否可见或启用是缺失的。
由于时间有限,源代码数量巨大,我决定忽略这些错误,因为焦点(在我们的情况下)不是一个关键特性。引发的Exception将导致完全失败,而缺少焦点只是一个光学问题。
我目前的计划如下:
1.我创建了一个单元,其中包含一个类助手,如下所示:
type TwinControlEx = TwinControl过程SetFocusSafe的类助手;结束;
程序TWinControlEx.SetFocusSafe;开始if CanFocus then SetFocus;结束;
1.我将该单元包含到使用“.SetFocus”的每个单元中(我将使用全局代码搜索)
1.我将每个.SetFocus替换为.SetFocusSafe
但有一个问题:如果可能的话,我希望避免同事意外使用.SetFocus,或者忘记包含classhelper单元。
我还有其他选择吗?
最好的情况是如果有一种技术/技巧可以使SetFocus不引发异常。(不需要重新编译VCL)

t9eec4r0

t9eec4r01#

只需修补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.
carvr3hs

carvr3hs2#

或者

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;
wgxvkvu9

wgxvkvu93#

我下面的回答并没有直接回答你的问题,但它仍然是相关的,因为你依赖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年更新

请参阅此new article about CanFocus以及如何修复它。您甚至可以找到一个工具,它将使用固定函数SetFocus()替换所有Control.SetFocus方法。
理由:
J提供了一个很好的答案,但我不喜欢类助手,因为如果你为同一个类提供了多个类助手,那么唯一的一个将被使用。这个过程几乎是“通过骰子”:“uses”子句中单元的顺序决定了哪个帮助器将被应用。我不喜欢编程语言中的这种随机性。

相关问题