Fehlermeldung abfangen: deaktiviertes Fenster kann Fokus nicht bekommen

[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.