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

Question

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.

Why not just hide the red frame when the window it is supposed to be "attached to" is not on top? — Warren P
That's not a solution, the frame should be only above it's parent form and stay there also when the user returns back to the form or when another application is focused but does not overlap the form. — oxo

Sertac Akyuz Sertac Akyuz · Accepted Answer · 2012-07-18T15:26:30

Do not test HandleAllocated in CreateParams, of course it hasn't been...

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;

Do not use fsStayOnTop if you don't want the form to stay on top.

procedure TOHighlightForm.DoCreate;
begin
  inherited;

  Color := clRed;
//  FormStyle := fsStayOnTop; // <-----
  BorderStyle := bsNone;
  Position := poDesigned;
  DoubleBuffered := True;
end;

Self is your main form, you'd want to use the form that would own the frame (the modal form)

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(GetParentForm(TControl(Sender), False), xR, 3); // <--------
  end;
end;

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

1 Answers