Modale Dialogboxen blinken lassen

[mael]

Euch ist vielleicht schon einmal aufgefallen, daß die Dialog-Boxen/Modale Fenster von Delphi-Anwendungen nicht "blitzen" (engl. flashing) wenn man auf darunterliegende Fenster klickt (was in normalen Windows-Anwendungen Standard ist). Außer einem Piep kommt nix.
Das hat mich lange genervt, also habe ich mich heute drangesetzt und habe eine Lösung gefunden.
Sogar ein Sonderfall der in Delphi 2005 (Demo) nicht ging geht hiermit in Delphi 7.

Es lies sich aber nicht vermeiden, daß Controls.pas entsprechend abgeändert werden muß.

Um den Bug zu fixen, in Controls.pas die Prozedur TWinControl.WMSetCursor durch den folgenden Code ersetzen:

Unter Windows 95 und NT 4.0 gibt es FlashWindowEx nicht, daher muß man es dynamisch laden. Dadurch haben sich ein paar Änderungen ergeben die leicht unübersichtlich erscheinen, weshalb ich eine diff-Datei angehängt habe.
Mit dem GNU-patch Tool kann man dann die Original-Datei im Source\VCL Ordner von Delphi 7 in die gefixte Version patchen. Dafür controls.diff aus Zip-Datei entpacken und das Kommando ausführen:
patch Controls.pas controls.diff

Delphi-Quellcode:

function FlashActivePopup(ClickedWindowHandle: HWND): Boolean;
var
  LastActivePopup: HWND;
  ClassName: array[0..255] of AnsiChar;
  IsDialog: Boolean;
begin
  // flash only on Windows 98+ or Windows 2000+ 
  if not (CheckWin32Version(4, 10) or CheckWin32Version(5, 0)) then
  begin
    Result := False;
    Exit;
  end;

  LastActivePopup := GetLastActivePopup(Application.Handle);

  GetClassName(LastActivePopup, @ClassName, 256);
  IsDialog := ClassName = '#32770';
  Result := IsDialog;
  
  // Windows already handles flashing if the parent is the clicked window
  Result := Result and (GetParent(LastActivePopup) <> ClickedWindowHandle);

  Result := Result or IsDelphiHandle(LastActivePopup) and
    (fsModal in TCustomForm(ObjectFromHWnd(LastActivePopup)).FormState);
end;

procedure TWinControl.WMSetCursor(var Message: TWMSetCursor);
var
  Cursor: TCursor;
  Control: TControl;
  P: TPoint;
  LastActivePopup: HWND;
  FlashInfo: FLASHWINFO;
begin
  with Message do
    if CursorWnd = FHandle then
      case Smallint(HitTest) of
        HTCLIENT:
          begin
            Cursor := Screen.Cursor;
            if Cursor = crDefault then
            begin
              GetCursorPos(P);
              Control := ControlAtPos(ScreenToClient(P), False);
              if (Control <> nil) then
                if csDesigning in Control.ComponentState then
                  Cursor := crArrow
                else
                  Cursor := Control.FCursor;
              if Cursor = crDefault then
                if csDesigning in ComponentState then
                  Cursor := crArrow
                else
                  Cursor := FCursor;
            end;
            if Cursor <> crDefault then
            begin
              Windows.SetCursor(Screen.Cursors[Cursor]);
              Result := 1;
              Exit;
            end;
          end;
        HTERROR:
          if (MouseMsg = WM_LBUTTONDOWN) and (Application.Handle <> 0) then
          begin
            LastActivePopup := GetLastActivePopup(Application.Handle);
            if (GetForegroundWindow <> LastActivePopup) then
            begin
              Application.BringToFront;
              Exit;
            end
            else if FlashActivePopup(Handle) then
            begin
              inherited; // make it beep
              
              FlashInfo.cbSize := sizeof(FlashInfo);
              FlashInfo.hwnd := LastActivePopup;
              FlashInfo.dwFlags := FLASHW_CAPTION;
              SystemParametersInfo(SPI_GETFOREGROUNDFLASHCOUNT, 0,
                @FlashInfo.uCount, 0);
              FlashInfo.dwTimeout := GetCaretBlinkTime div 8;
              FlashWindowEx(FlashInfo);

              Exit; // do not execute inherited again
            end;
          end;
      end;
  inherited;
end;

[edit=Chakotay1308]Beitrag angepasst. Mfg, Chakotay1308[/edit]
[edit=Chakotay1308]Anhang geupdatet. Mfg, Chakotay1308[/edit]