CODEWITHSUNDEEP
delphivclsetfocus
Daniel Marschall
Daniel Marschall

Reputation: 3879

Avoid that SetFocus raises an Exception

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)

Upvotes: 7

Views: 2328

Answers (3)

IceCold
IceCold

Reputation: 21202

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

So, you will have to write a new CanFocus that tests not only the state of the current control but ALL its parents. You will end up with a recursive call. Only then you can write a new SetFocus that really works:

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

Full code and explanation here in this article from my website: Setfocus-is-broken-in-Delphi There is also a tool to batch replace the broken SetFocus with my safe alternative.

Justification:

J provided a nice answer, but PERSONALLY I don't like class helpers because if you have more than one class helper for the same class, then only one will be used - which one is determined (almost randomly) by the order of the units in the "uses" clause. Accidentally change the order of the units in the "uses" and you accidentally change the behavior of your program! I don't like this amount of randomness in a programming language. Until Emba comes with a stable solution, I won't use Class Helpers.

Upvotes: 4

J...
J...

Reputation: 31443

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;

Upvotes: 4

Stefan Glienke
Stefan Glienke

Reputation: 21748

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.

Upvotes: 7

Related Questions