Shadow underneath Form does not always appear (CS_DROPSHADOW)

[PeaShooter_OMO 34]

In Delphi 11, Windows 10...

 

I have a small project where I create a form (the same Form object) with two different states; a Normal form and a Borderless Shadowed form (created via CreateParams and CS_DROPSHADOW).

 

After starting the program, if I create the Borderless form first then the shadow will be there. If I create the Normal form first and then the Borderless form then the shadow of the Borderless form will not be there.

 

Attached you will find a .zip file with the project.

Project.zip

Steps to produce the strange behaviour...

1. Start the program
2. Create the Normal form first
3. Close the Normal form via the "Close" button.
4. Create the Borderless Shadowed Popup form. Notice the shadow does not appear.
5. You can close and create all you like. The shadow never appears beneath the Borderless form.

 

Steps to produce a shadow at all times...

1. Start the program
2. Create the Borderless Shadowed Popup form first. Notice the shadow is correctly appearing.
3. Close the Borderless form.
4. Create the Normal form.
5. Close the Normal form.
6. Create the Borderless Shadowed Popup form again. Notice the shadow is correctly appearing.
7. You can flip-clop between the two as much as you like, the shadow will always be there.

 

Obviously I would expect the Borderless form to always have its shadow. Am I doing something wrong?

 

type
  TFormMain = class(TForm)
    ButtonCreateNormal: TButton;
    ButtonCreateBorderless: TButton;
    procedure ButtonCreateNormalClick(Sender: TObject);
    procedure ButtonCreateBorderlessClick(Sender: TObject);
  private
  public
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}

uses UnitPopup;

procedure TFormMain.ButtonCreateBorderlessClick(Sender: TObject);
begin
  FormPopup := TFormPopup.Create(True);
  FormPopup.Show;
end;

procedure TFormMain.ButtonCreateNormalClick(Sender: TObject);
begin
  FormPopup := TFormPopup.Create(False);
  FormPopup.Show;
end;

type
  TFormPopup = class(TForm)
    Panel1: TPanel;
    ButtonClose: TButton;
    procedure ButtonCloseClick(Sender: TObject);
  private
    FIsBorderlessPopup : Boolean;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AIsBorderlessPopup : Boolean); reintroduce;
  end;

var
  FormPopup: TFormPopup;

implementation

{$R *.dfm}

procedure TFormPopup.ButtonCloseClick(Sender: TObject);
begin
  FreeAndNil(FormPopup);
end;

constructor TFormPopup.Create(AIsBorderlessPopup : Boolean);
begin
  FIsBorderlessPopup := AIsBorderlessPopup;

  inherited Create(nil);

  If FIsBorderlessPopup then
    begin
      Panel1.BorderStyle := bsSingle;
      Panel1.Caption := 'Borderless Shadowed';
    end
  else
    begin
      Panel1.BorderStyle := bsNone;
      Panel1.Caption := 'Normal Form';
    end;
end;

procedure TFormPopup.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  If FIsBorderlessPopup then
    begin
      Params.Style := WS_POPUP;
      Params.WindowClass.style := Params.WindowClass.style or CS_DROPSHADOW;
      Params.ExStyle := WS_EX_TOPMOST;
    end;
end;

 

Edited Wednesday at 07:55 AM by PeaShooter_OMO

[Kas Ob. 138]

28 minutes ago, PeaShooter_OMO said:

Am I doing something wrong?

Nothing wrong, just missed "RecreateWnd;" after setting the Params.

[Anders Melander 1988]

8 minutes ago, Kas Ob. said:

Nothing wrong, just missed "RecreateWnd;" after setting the Params.

I don't get it. Isn't CreateParams called before the window handle is created? Then why would RecreateWnd be necessary?

[Kas Ob. 138]

24 minutes ago, Anders Melander said:

I don't get it. Isn't CreateParams called before the window handle is created? Then why would RecreateWnd be necessary?

It is beyond me why it is needed, short coming in CM_RECREATEWND that used to trigger the recreation and when it is received, (i think )

 

It could be made better but will break things, also may be things changed in newer VCLs but in the older ones RecreateWnd is needed, even it means the recreation will happen twice.

[Kas Ob. 138]

Testing the real project and now i see even with RecreateWnd it is not reliable, and acting as there is something is not initialized.

 

On XE8, the same code with RecreateWnd, act differently with or without debug dcu included in project settings !,

and if there is a break point that halted the code execution then the shadow might appear more frequently. 

[Kas Ob. 138]

Found the culprit of this discrepancy, but don't have a solution, or lets say nice solution, on top of that my old VCL is irrelevant to the most , so , someone else should have a deeper look into this.

 

There is two different RegisterClass functions, one belong to Delphi RTL and the other is an OS API, Delphi Forms like other controls do register them selves with RegisterClass with unique name, on both API and RTL, the one is causing this problem is API how Windows store the style, Delphi RTL doesn't handle UnregisterClass (API) correctly or not calling it at all, hence CreateParams and the following creating the control (and setting its modern and advanced style) stay short from performing as intended.

 

As a workaround a suggest to refactor your popup into base and two inherited ones hence forcing the class name used by RegisterClass to be different, one with shadow and the other without, this will be the most clean way, though it must be tested.

 

ps: @PeaShooter_OMO don't call "FreeAndNil(FormPopup);" on Self, this is problematic and dangerous, just use "Release;" and it will be released in orderly form, and you can skip the var usage altogether by using 

  with TFormPopup.Create(True) do
    Show;
// or 
  with TFormPopup.Create(False) do
    Show;

 

[PeaShooter_OMO 34]

@Kas Ob.

Deriving another class for the Borderless form did the trick. It is an interesting one, indeed.

 

Thank you for your input.

[dwrbudr 8]

procedure TFormPopup.CreateParams(var Params: TCreateParams);
var ClassRegistered: boolean;
    TempClass: TWndClass;
begin
  inherited CreateParams(Params);

  ClassRegistered := GetClassInfo(Params.WindowClass.hInstance, Params.WinClassName, TempClass);
  if ClassRegistered then
  begin
    Winapi.Windows.UnregisterClass(Params.WinClassName, Params.WindowClass.hInstance);
  end;

  If FIsBorderlessPopup then
    begin
      Params.Style := WS_POPUP;
      Params.WindowClass.style := Params.WindowClass.style or CS_DROPSHADOW;
      Params.ExStyle := WS_EX_TOPMOST;
  end;
end;

 

[Kas Ob. 138]

2 hours ago, dwrbudr said:

procedure TFormPopup.CreateParams(var Params: TCreateParams);
var ClassRegistered: boolean;
    TempClass: TWndClass;
begin
  inherited CreateParams(Params);

  ClassRegistered := GetClassInfo(Params.WindowClass.hInstance, Params.WinClassName, TempClass);
  if ClassRegistered then
  begin
    Winapi.Windows.UnregisterClass(Params.WinClassName, Params.WindowClass.hInstance);
  end;

  If FIsBorderlessPopup then
    begin
      Params.Style := WS_POPUP;
      Params.WindowClass.style := Params.WindowClass.style or CS_DROPSHADOW;
      Params.ExStyle := WS_EX_TOPMOST;
  end;
end;

 

If only it was this simple !

 

The idea is right, but the complications can be huge.

 

1) The code is not handling the failure of UnregisterClass.

2) UnregisterClass will fail if there is a Window still online associated with that class, by online i mean created and/or visible, simply a window with that class exists, from https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-unregisterclassa

Before calling this function, an application must destroy all windows created with the specified class.

3) even if did pass and succeeded then there is the other caching software that might already read and copied the Class and its information and might fail, like live translation software or the one for accessibility that read the content of the screen or the ones that completely redraw them in different way (out of the OS theming), such software will behave erratically if performed something at that moment and Windows reported an error with the associated WindowClass.

 

So, i don't recommend such approach, if UnregisterClass should be called then it should put at lower level (deep) in the VCL in appropriated place, and it must recreate all the already created Forms, dialogs, controls... it is huge adjustment.

 

[Remy Lebeau 1592]

3 hours ago, dwrbudr said:

procedure TFormPopup.CreateParams(var Params: TCreateParams);
var ClassRegistered: boolean;
    TempClass: TWndClass;
begin
  inherited CreateParams(Params);

  ClassRegistered := GetClassInfo(Params.WindowClass.hInstance, Params.WinClassName, TempClass);
  if ClassRegistered then
  begin
    Winapi.Windows.UnregisterClass(Params.WinClassName, Params.WindowClass.hInstance);
  end;

  If FIsBorderlessPopup then
    begin
      Params.Style := WS_POPUP;
      Params.WindowClass.style := Params.WindowClass.style or CS_DROPSHADOW;
      Params.ExStyle := WS_EX_TOPMOST;
  end;
end;

 

You should not need to resort to this.  The VCL already calls UnregisterClass() and RegisterClass() after CreateParams() exits.  The purpose of CreateParams() is just to report the class details that the control wants, not to manipulate the registration directly.