Delphi parented window stays at top of others when created in a modal form
===

I create a window, that should highlight a control on a form. This window should **not** stay on top of other application windows when the parent form is behind another window (try Alt+Tab).
This works fine unless the red frame has been created from a modal form.

What I want to achieve is that the red frame won't stay at top of other windows when created from a modal dialog and you switch to another application.

I'd like to omit PopupParent and PopupMode since the code should work in Delphi 7 - XE2 (honestly I tried to play with PopupParent without any success).

The fact that the frame is not closed is not an issue.

Please check the full source code below (create a new VCL application and replace whole unit text, don't place any components on the form).

    unit Unit1;

    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics,
      Controls, Forms, Dialogs, StdCtrls;
    
    type
      TForm1 = class(TForm)
      private
        procedure HighlightButton(Sender: TObject);
        procedure CreateModalDialog(Sender: TObject);
      protected
        procedure DoCreate; override;
      end;
    
      TOHighlightForm = class(TForm)
      private
        fxPopupParent: TCustomForm;
        procedure SetFormLook;
        procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
        procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
      protected
        procedure Paint; override;
        procedure DoCreate; override;
        procedure Resize; override;
        procedure CreateParams(var Params: TCreateParams); override;
      public
        procedure ShowAt(const aPopupParent: TCustomForm; aRect: TRect; const aInflateRect: Integer = 0);
      end;
    
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    { TOHighlightForm }
    
    procedure TOHighlightForm.CreateParams(var Params: TCreateParams);
    begin
      inherited CreateParams(Params);
    
      if HandleAllocated then
      with Params do begin
        if Assigned(fxPopupParent) then
          WndParent := fxPopupParent.Handle;
      end;
    end;
    
    procedure TOHighlightForm.DoCreate;
    begin
      inherited;
    
      Color := clRed;
    
      FormStyle := fsStayOnTop;
      BorderStyle := bsNone;
      Position := poDesigned;
      DoubleBuffered := True;
    end;
    
    procedure TOHighlightForm.Paint;
    begin
      with Canvas do begin
        Brush.Color := Self.Color;
        FillRect(Self.ClientRect);
      end;
    end;
    
    procedure TOHighlightForm.Resize;
    begin
      inherited;
    
      SetFormLook;
      Repaint;
    end;
    
    procedure TOHighlightForm.SetFormLook;
    var
      HR1, HR2: HRGN;
      xR: TRect;
    begin
      if not HandleAllocated then
        exit;
    
      xR := Self.ClientRect;
    
      HR1 := CreateRectRgnIndirect(xR);
      InflateRect(xR, -3, -3);
      HR2 := CreateRectRgnIndirect(xR);
    
      if CombineRgn(HR1, HR1, HR2, RGN_XOR) <> ERROR then
        SetWindowRgn(Handle, HR1, True);
    end;
    
    procedure TOHighlightForm.ShowAt(const aPopupParent: TCustomForm; aRect: TRect;
      const aInflateRect: Integer);
    begin
      if fxPopupParent <> aPopupParent then begin
        fxPopupParent := aPopupParent;
        RecreateWnd;
      end;
    
      if aInflateRect > 0 then
        InflateRect(aRect, aInflateRect, aInflateRect);
    
      SetBounds(aRect.Left, aRect.Top, aRect.Right-aRect.Left, aRect.Bottom-aRect.Top);
    
      Resize;
    
      ShowWindow(Handle, SW_SHOWNOACTIVATE);
      Visible := True;
    end;
    
    procedure TOHighlightForm.WMMouseActivate(var Message: TWMMouseActivate);
    begin
      Message.Result := MA_NOACTIVATE;
    end;
    
    procedure TOHighlightForm.WMNCHitTest(var Message: TWMNCHitTest);
    begin
      Message.Result := HTTRANSPARENT;
    end;
    
    { TForm1 }
    
    procedure TForm1.CreateModalDialog(Sender: TObject);
    var xModalForm: TForm;
    begin
      xModalForm := TForm.CreateNew(Self);
      try
        with TButton.Create(Self) do begin
          Parent := xModalForm;
          Top := 70;
          Left := 10;
          Width := 200;
          OnClick := HighlightButton;
          Caption := 'This does not work (try Alt+Tab)';
        end;
    
        xModalForm.ShowModal;
      finally
        xModalForm.Free;
      end;
    end;
    
    procedure TForm1.DoCreate;
    begin
      inherited;
    
      with TLabel.Create(Self) do begin
        Parent := Self;
        Left := 10;
        Top := 10;
        Caption :=
          'I create a window, that should highlight a control on a form.'#13#10+
          'This window should not stay on top of other application windows when'#13#10+
          'the parent form is behind another window (try Alt+Tab).'#13#10+
          'This works fine unless it is a modal form.';
      end;
    
      with TButton.Create(Self) do begin
        Parent := Self;
        Top := 70;
        Left := 10;
        Width := 200;
        OnClick := HighlightButton;
        Caption := 'This works fine';
      end;
    
      with TButton.Create(Self) do begin
        Parent := Self;
        Top := 100;
        Left := 10;
        Width := 200;
        OnClick := CreateModalDialog;
        Caption := 'Open modal window and try there';
      end;
    end;
    
    procedure TForm1.HighlightButton(Sender: TObject);
    var
      xR: TRect;
      xControl: TControl;
    begin
      xControl := TControl(Sender);
      xR.TopLeft := xControl.ClientToScreen(Point(0, 0));
      xR.BottomRight := Point(xR.Left+xControl.Width, xR.Top+xControl.Height);
    
      with TOHighlightForm.CreateNew(Self) do begin
        ShowAt(Self, xR, 3);
      end;
    end;
    
    end.