Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

[SearchBot]

Hallo,

ich steuere im Programm, welcher Button oder EditFeld den Fokus bekommt.
Das geht manchmal schief und die Meldung "deaktiviertes Fenster kann Fokus nicht bekommen" oder so ähnlich.

Dieses Meldungsfenster verhindert jede weitere Funktion des Programms, bis es bestätigt wurde - sehr lästig.
Und es steht aber dummerweise nicht drin, welches Element das ausgelöst hat, was das Debuggen nicht vereinfacht.

Kann ich iwie diese Meldung global abfangen und behandeln?

[himitsu]

Delphi-Quellcode:

if e.CanFocus then
  e.SetFocus;

Nein, es steht leider nicht drin, auch wenn die Stelle der Fehlermeldung es weiß. (leider wurde sowas bei zuvielen Fehlermeldungen vergessen)

Es ist leider auch nicht "einfach" möglich das nachzurüsten, denn dieser Fehler wird an mehreren Stellen ausgelöst und ein paar der Methoden sind nicht virtual.
Und im StackTrace ist der Verursacher nicht immer sichtbar (der, welcher ein PostMessage ausgelöst hat) ... manchmal schon, also könntest du dir Application.OnException (TApplicationEvents) überschreiben und dir dort den Stacktrace ansehen, bzw. sowas wie Eurekalog verwenden.

Statt Stackstrace im Programm geht es auch im Debugger.
Und man kann ich auch im Nachhinein mit dem Debugger anhängen, so lange der Fehlerdialog noch offen ist, auf Pause gehen und in den Mainthread wechseln.

[SearchBot]

Danke für deine Antwort.

Problem ist hier, daß es eben beim Anwender passiert und ich dann kein Debugger da habe und ich so auch nicht nachvollziehen kann, was der da "falsch" macht in der Bedienung...

Aber den Tipp mit dem CanFocus werde ich mal an wichtigen Stellen einbauen

[Neumann]

Auf das "CanFocus" kann man sich leider nicht unbedingt verlassen.

Es gibt dann noch "visible" und "enabled" aber hilft auch nicht immer.

Try Except würde verhindern dass der Endbenutzer eine für ihn unverständliche Fehlermeldung bekommt, aber dann muss man selber etwas machen.

[Ralf Kaiser]

Zitat von Neumann:

Auf das "CanFocus" kann man sich leider nicht unbedingt verlassen.

Es gibt dann noch "visible" und "enabled" aber hilft auch nicht immer.

Doch. Kann man. Denn genau das fragt "CanFocus" nämlich ab:

Delphi-Quellcode:

function TWinControl.CanFocus: Boolean;
var
  Control: TWinControl;
  Form: TCustomForm;
begin
  Result := False;
  Form := GetParentForm(Self);
  if Form <> nil then
  begin
    Control := Self;
    while Control <> Form do
    begin
      if not (Control.FVisible and Control.Enabled) then Exit;
      Control := Control.Parent;
    end;
    Result := True;
  end;
end;

[himitsu]

Ich hatte bei uns mal mühevoll versucht die meisten Stellen für SetFocus und seine Freunde zu finden und mich dann da rein zu hängen, um die Fehlermeldung entsprechend um den Namen zu erweitern.
Aber alle Stellen hab ich leider nicht erwischt, welche die Kunden schaffen auszulösen.

Du kannst ja gern mal in deinen Delphi-Quellcodes nach SCannotFocus, SParentRequired und SParentGivenNotAParent suchen
und versuchen, ob du diese Stellen erweitern/überschreiben kannst.

Wir haben hier fast alle Komponenten erstmal abgeleitet, und können so problemlos zentral Bugfixe und Funktionserweiterungen in den hunderten Formularen verteilen.

Auf die Schnelle fand ich jetzt das hier

Delphi-Quellcode:

type
  TGrundForm = class(TForm)
  private
    procedure SetActiveControl(Control: TWinControl); {override;}  // TCustomForm.SetActiveControl ist leider nicht virtuell, darum anschließend zumindestens der Setter überdeckt.
  public
    class procedure FocusError_Init(COwner: TComponent; Control: TWinControl; out LastControl, LastGlobalControl: TWinControl); static;
    class procedure FocusError_Exec(const ObjectClass, FuncName: string; COwner: TComponent; Control, LastControl, LastGlobalControl: TWinControl; WithoutDest: Boolean=False); static;

    {$REGION 'Documentation'}
    ///   <summary>
    ///     Ordentliche Fehlermeldung inkl. Name des betreffenden Controls.<br /><br />SCannotFocus = 'Ein deaktiviertes
    ///     oder unsichtbares Fenster kann nicht den Fokus erhalten'
    ///   </summary>
    ///   <remarks>
    ///     <code lang="Delphi">
    ///   TCustomForm = class(TScrollingWinControl)
    ///   private
    ///     procedure SetActive(Value: Boolean);                                    // SetWindowFocus
    ///     procedure SetActiveControl(Control: TWinControl);                       // SetWindowFocus + Exception(SCannotFocus)
    ///     procedure SetVisible(Value: Boolean);                                   // SetWindowToMonitor + Inherited:=Value
    ///     procedure SetWindowFocus;                                               // Windows.SetFocus
    ///     procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;    // SetActive
    ///     //procedure CMActivate(var Message: TCMActivate); message CM_ACTIVATE;  // Activate
    ///   protected
    ///     //procedure Activate; dynamic;                                          // CM_ACTIVATE
    ///   public
    ///     procedure DefocusControl(Control: TWinControl; Removing: Boolean);      // SetActiveControl
    ///     procedure FocusControl(Control: TWinControl);                           // SetActiveControl + Windows.SetFocus
    ///     procedure SetFocus; override;                                           // SetWindowFocus + Exception(SCannotFocus)
    ///     function  SetFocusedControl(Control: TWinControl): Boolean; virtual;    // Screen.ActiveControl + CM_EXIT/CM_ENTER, CM_FOCUSCHANGED, CM_ACTIVATE/CM_DEACTIVATE
    ///   end;</code>
    ///   </remarks>
    {$ENDREGION}
    procedure SetFocus; override;
    function  SetFocusedControl(Control: TWinControl): Boolean; override;
    property  ActiveControl write SetActiveControl;
  end;

  TMyRichEdit = class(TRichEdit)
  public
    procedure SetFocus; override;
  end;

  TMyButton = class(TButton)
  public
    procedure SetFocus; override;
  end;

  ...

function TGrundForm.FindNextControl(CurControl: TWinControl; GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
begin
  Result := inherited FindNextControl(CurControl, GoForward, CheckTabStop, CheckParent);
  if not Assigned(Result) then
    Result := inherited FindNextControl(nil, GoForward, CheckTabStop, CheckParent);  // ActiveControl ist das Letzte => von Vorne
end;

class procedure TGrundForm.FocusError_Exec(const ObjectClass, FuncName: string; COwner: TComponent; Control, LastControl, LastGlobalControl: TWinControl; WithoutDest: Boolean);
var
  S, S2: string;
begin
  {on E: Exception do begin}
  Assert(ExceptObject <> nil, 'TGrundForm.FocusError_Exec wurde nicht innerhalb von except-end aufgerufen');
  if not Assigned(COwner) then
    COwner := Control;

  // Abort unverändert durchreichen
  if ExceptObject is EAbort then
    if EAbort(ExceptObject).Message <> LoadResString(@SOperationAborted) then
      raise EAbort.Create(EAbort(ExceptObject).Message)  // wie "raise;" aber da nicht direkt im except-end, muß das Objekt neu erstellt werden, denn "raise ExceptObject;" würde knallen, da doppelte Freigabe. (Delphi prüft nicht, ob das selbe Objekt erneut reingegeben wird)
    else
      Abort;

  // die Position wurde bereits eingetragen (verschachtelte Aufrufe: z.B. SetFocus > SetWindowFocus)
  S := COwner.SecureClassName(ObjectClass);
  if StartsStr('.SetFocus', FuncName) and StartsStr(S + '.SetFocus', Exception(ExceptObject).Message) then
    raise ExceptClass(ExceptObject.ClassType).Create(Exception(ExceptObject).Message) at ExceptAddr;

  if WithoutDest then
    S := COwner.SecureClassName(ObjectClass) + FuncName + ' from ' + LastControl.SecureFullName
  else
    S := COwner.SecureClassName(ObjectClass) + FuncName + ' to ' + Control.SecureFullName + ' from ' + LastControl.SecureFullName;
  if Assigned(LastGlobalControl) and (LastGlobalControl <> LastControl) then
    S := S + ' [' + LastGlobalControl.SecureFullName +  ']';
  if (Screen.ActiveControl <> Control) and (Screen.ActiveControl <> LastGlobalControl) then
    S := S + ' now on ' + Screen.ActiveControl.SecureFullName;
  S := S + ':'#10;

  try
    while Assigned(Control) do begin
      S2 := '';
      if Control.HandleAllocated then begin
        if not IsWindowVisible(Control.Handle) and Control.Visible then
          S2 := S2 + 'Hidden** '
        else if not Control.Visible then
          S2 := S2 + 'Hidden ';
        if not IsWindowEnabled(Control.Handle) and Control.Enabled then
          S2 := S2 + 'Disabled** '
        else if not Control.Enabled then
          S2 := S2 + 'Disabled ';
      end else begin
        if not Control.Visible then
          S2 := S2 + 'Hidden ';
        if not Control.Enabled then
          S2 := S2 + 'Disabled ';
      end;
      if S2 <> '' then
        if (Control.Name <> '') then
          S := S + Control.Name + ' = ' + Trim(S2) + #10
        else if (Control.Name = '') and ContainsStr(Control.ClassName, 'Inner') and Assigned(Control.Parent) and (Control.Parent.Name <> '') then
          S := S + Control.Parent.Name + ' = ' + Trim(S2) + #10
        else
          S := S + Control.SecureFullName + ' = ' + Trim(S2) + #10;
      Control := Control.Parent;
    end;
  except
  end;
  S := S + Exception(ExceptObject).Message;
  raise ExceptClass(ExceptObject.ClassType).Create(S) at ExceptAddr;
end;

class procedure TGrundForm.FocusError_Init(COwner: TComponent; Control: TWinControl; out LastControl, LastGlobalControl: TWinControl);
begin
  LastControl       := nil;
  LastGlobalControl := nil;
  try
    if not Assigned(COwner) then
      COwner := Control;

    // Global (auch auf anderdem Fenster)
    LastGlobalControl := Screen.ActiveControl;
    // nur im eigenen Fenster (andere Fenster ignorieren)
    if COwner is TCustomForm then  // falls nicht direkt als Form übergeben > einfach nachfolgend mit behandeln lassen (MDI-Child)
      LastControl := TForm(COwner).ActiveControl;
    // bei MDI-Childs und eingegetteten Fenstern im Parent suchen
    while Assigned(COwner) and not not Assigned(LastControl) do begin
      if COwner is TControl then
        COwner := TControl(COwner).Parent
      else
        COwner := COwner.Owner;
      if COwner is TCustomForm then
        LastControl := TForm(COwner).ActiveControl;
    end;
  except
  end;
  if not Assigned(LastControl) then
    LastControl := LastGlobalControl;
end;

procedure TGrundForm.SetActiveControl(Control: TWinControl);
var
  LastControl, LastGlobalControl: TWinControl;
begin
  TGrundForm.FocusError_Init(Self, Control, LastControl, LastGlobalControl);
  try
    //inherited;
    inherited ActiveControl := Control;
  except
    TGrundForm.FocusError_Exec('TGrundForm', '.SetFocus/SetActiveControl', Self, Control, LastControl, LastGlobalControl);
  end;
end;

procedure TGrundForm.SetFocus;
var
  LastControl, LastGlobalControl: TWinControl;
begin
  TGrundForm.FocusError_Init(nil, Self, LastControl, LastGlobalControl);
  try
    inherited;
  except
    TGrundForm.FocusError_Exec('TGrundForm', '.SetFocus', nil, Self, LastControl, LastGlobalControl);
  end;
end;

function TGrundForm.SetFocusedControl(Control: TWinControl): Boolean;
var
  LastControl, LastGlobalControl: TWinControl;
begin
  TGrundForm.FocusError_Init(Self, Control, LastControl, LastGlobalControl);
  try
    Result := inherited;
  except
    TGrundForm.FocusError_Exec('TGrundForm', '.SetFocus/SetFocusedControl', Self, Control, LastControl, LastGlobalControl);
  end;
end;

...

procedure TMyButton.SetFocus;
var
  LastControl, LastGlobalControl: TWinControl;
begin
  TGrundForm.FocusError_Init(nil, Self, LastControl, LastGlobalControl);
  try
    inherited;
  except
    TGrundForm.FocusError_Exec('TMyButton', '.SetFocus', nil, Self, LastControl, LastGlobalControl);
  end;
end;

und das auch noch, auch wenn es aktuell aus ist

Delphi-Quellcode:

procedure THauptForm.FormCreate(Sender: TObject);
//var
//  P: PByte;
//  L: LongWord;
begin
  {$REGION 'Hook ValidParentForm < MyValidParentForm'}  // Fehlermmeldung erweitern, so wie auch schon beim SetFocus
  {$IFDEF WIN32}
  (*
  SParentRequired = Element '...' hat kein übergeordnetes Fenster / Control '...' has no parent window
    TControl.GetClientOrigin
    TControl.GetDeviceContext
    TControl.ClientToParent
    TControl.ParentToClient
    TWinControl.CreateWnd
    Forms.ValidParentForm

  if not IsDebuggerPresent then begin
    P := @ValidParentForm;
    Assert(PWord(P)^ = $25FF);
    P := PPointer(P + SizeOf(Word))^;  // Speicheradresse zur ImportTable in JumpList
    P := PPointer(P)^;                 // Adresse zur Prozedur in DLL-ImportTable
    if VirtualProtect(P, SizeOf(Byte) + SizeOf(Pointer), PAGE_EXECUTE_READWRITE, L) then begin
      P^ := $E9;  // JMP
      PNativeInt(P + SizeOf(Byte))^ := NativeInt(@MyValidParentForm) - NativeInt(P) - (SizeOf(Byte) + SizeOf(Pointer));
      VirtualProtect(P, SizeOf(Byte) + SizeOf(Pointer), L, L);
    end;
  end;
  *)
  {$ENDIF}
  {$ENDREGION}

Das mit dem LastGlobalControl ist dem geschuldet, dass wir ein paar MDI-Childs haben und dort der Fokus nicht beim Fenster selbst liegt, ebenso wie auch bei eingebetteten Forms, sondern bei der obersten ParentForm (TopLevelFrom).

Und beim Hook nicht wundern, der ist darauf ausgelegt, dass wir mit Packages arbeiten und da mußte der Hook halt in das VCL-Package rein ... ohne Packages sieht das bissl anders aus, so wie in den unzähligen Hook-Tutorials.

[hoika]

Hallo,
eigene Methode schreiben (Edit_SetFocus),
Edit als Parameter,
drin ein
Try
Except

Und dann alle Edit.SetFocus durch die neue Methode ersetzen

[stahli]

Wenn man ein Control löscht, das den Fokus hat, kann das auch zu einer Fehlermeldung führen.

Workaround: Erst mal nur Visible = False setzen, Control merken und löschen, wenn ein anderes Control den Fokus bekommen hat.