unit UnitFrmDummyAlwaysOnTopFix;
//
// Windows Sucks. Showing a full screen vidoe a few times breaks all
// always-on-top windows.
//
// This form re-sets HWND_TOPMOST on a regular interval for visible windows.
// I was unable to find any event that was triggered when the z-order was lost.
//

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TFrmDummyAllwaysOnTopFix = class(TForm)
    timExecuteFix: TTimer;
    procedure timExecuteFixTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmDummyAllwaysOnTopFix: TFrmDummyAllwaysOnTopFix;

implementation

{$R *.dfm}

uses UnitFrmTriggerWindow, UnitFrmDummyClipboardBar, UnitMisc;

procedure TFrmDummyAllwaysOnTopFix.timExecuteFixTimer(Sender: TObject);
    function IsOnTopProblem(hnd : THandle) : boolean;
    var
        h : THandle;
        i : integer;
        s : string;
    begin
        // there's a problem when any non-topmost window is found before
        // the target window is found

        result := false;
        h := GetTopWindow(0);
        h := GetWindow(h, GW_HWNDFIRST);

        repeat
            if h = hnd then begin
                result := false;
                EXIT;
            end;
            i := GetWindowLong(h, GWL_EXSTYLE);
            h := GetWindow(h, GW_HWNDNEXT);
        until (i and WS_EX_TOPMOST) = 0;

        result := true;
    end;
    procedure ApplyFix(handle : THandle);
    begin
        SetWindowPos(
            Handle, HWND_TOPMOST,
            0,0,0,0,
            SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE
        );
    end;
    procedure CheckForm(f : TForm);
    begin
        if assigned(f) and f.Visible then begin
            if IsOnTopProblem(f.Handle) then
                ApplyFix(f.Handle);
        end;
    end;
begin
    CheckForm(FrmTriggerWindow);
    CheckForm(frmClipboardBar);
end;

end.
