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.

Answer 1

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;