Avoid that SetFocus raises an Exception

Question

I am working at a huge, legacy source code where several SetFocus is called at many places, but sometimes, the check if the control is visible or enabled is missing.

Due to limited time, and the huge amount of source code, I decided that I want to ignore these errors, since the focus is (in our case) not a critical feature. A raised Exception will result in a complete failure, while a missing focus is just an optical issue.

My current plan is following:

1. I create an unit with a class helper like this:

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

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

2. I include the unit to every unit which uses ".SetFocus" (I will use the global code search)

3. I replace every .SetFocus with .SetFocusSafe

There is a problem though: If possible, I want to avoid that coworkers accidently use .SetFocus , or forget to include the classhelper unit.

Which other options do I have?

The best case would be if there is a technique/hack to make SetFocus not raising an exception. (Without recompiling the VCL)

Answer 1

Just patch the TWinControl.SetFocus method:

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

Alternatively

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

with...

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

My answer below does not answer DIRECTLY your question but it is still relevant because you rely on CanFocus. CanFocus returns a lie. You should not rely on it. The documentation is also wrong. More exactly, CanFocus can return True even if the control is not focusable. In this case an exception will be raised.

So, use this instead:

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: Under Lazarus CanFocus works properly.

Update 2023

Please see this new article about CanFocus and how to fix it. You can find there even a tool that will replace all Control.SetFocus methods with the fixed function SetFocus().

---

Justification:

J provided a nice answer, but I don't like class helpers because if you have more than one class helper for the same class, the only one will be used. The process is almost "by dice": the order of the units in the "uses" clause determine which helper will apply. I don't like this amount of randomness in a programming language.