AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein GUI-Design mit VCL / FireMonkey / Common Controls Delphi Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

Ein Thema von SearchBot · begonnen am 6. Mai 2020 · letzter Beitrag vom 6. Mai 2020
Antwort Antwort
SearchBot

Registriert seit: 27. Jun 2004
Ort: N-W vom Bodensee
317 Beiträge
 
Delphi 12 Athens
 
#1

Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 12:08
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?
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.146 Beiträge
 
Delphi 12 Athens
 
#2

AW: Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 12:17
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 (Delphi-Referenz durchsuchenTApplicationEvents) ü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.
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PosEx im Delphi viel seltener praktiziert.

Geändert von himitsu ( 6. Mai 2020 um 12:24 Uhr)
  Mit Zitat antworten Zitat
SearchBot

Registriert seit: 27. Jun 2004
Ort: N-W vom Bodensee
317 Beiträge
 
Delphi 12 Athens
 
#3

AW: Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 12:31
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
  Mit Zitat antworten Zitat
Neumann

Registriert seit: 6. Feb 2006
Ort: Moers
536 Beiträge
 
Delphi 12 Athens
 
#4

AW: Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 12:47
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
Gruß vom Niederrhein
  Mit Zitat antworten Zitat
Benutzerbild von Ralf Kaiser
Ralf Kaiser

Registriert seit: 21. Mär 2005
Ort: Wuppertal
932 Beiträge
 
Delphi 10.3 Rio
 
#5

AW: Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 12:56
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;
Ralf Kaiser
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.146 Beiträge
 
Delphi 12 Athens
 
#6

AW: Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 13:47
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.
Neuste Erkenntnis:
Seit Pos einen dritten Parameter hat,
wird PosEx im Delphi viel seltener praktiziert.

Geändert von himitsu ( 6. Mai 2020 um 13:56 Uhr)
  Mit Zitat antworten Zitat
hoika

Registriert seit: 5. Jul 2006
Ort: Magdeburg
8.276 Beiträge
 
Delphi 10.4 Sydney
 
#7

AW: Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 23:04
Hallo,
eigene Methode schreiben (Edit_SetFocus),
Edit als Parameter,
drin ein
Try
Except

Und dann alle Edit.SetFocus durch die neue Methode ersetzen
Heiko
  Mit Zitat antworten Zitat
Benutzerbild von stahli
stahli

Registriert seit: 26. Nov 2003
Ort: Halle/Saale
4.343 Beiträge
 
Delphi 11 Alexandria
 
#8

AW: Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

  Alt 6. Mai 2020, 23:44
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.
Stahli
http://www.StahliSoft.de
---
"Jetzt muss ich seh´n, dass ich kein Denkfehler mach...!?" Dittsche (2004)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:19 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz