Enable Windows 10 Aero Glass a.k.a Blur Behind in our Delphi project

Enable Windows 10 Aero Glass a.k.a Blur Behind in our Delphi project

  15:40    vhanla

---

When Windows 8 arrived, it removed the Aero Glass feature from the operating system, some of us missed that feature and there are also some projects like http://www.glass8.eu/ which allows us to have Aero Glass back.
But now in Windows 10, this feature is back or kinda, because it remains as undocumented and only shown in the new Start Menu and some Immersive Applications like popups (Volume, Notification Center and other few ones).
However, we still need the old Aero Glass API before applying the Blur Behind “patch” in order to make it work again in our application.

In Delphi XE+ we just need to enable it using the Form’s GlassFrame property, but if you are using older Delphi versions, you needed to call the DWM API by yourself, something like the following:

DwmIsCompositionEnabled:function (pfEnabled: PBOOL):HRESULT;stdcall;
DwmExtendFrameIntoClientArea:function (hWnd: HWND; Margins: PRect):HRESULT;stdcall;

//...
  
procedure TForm1.AeroGlass;
var  
  Aero: BOOL;
  Area: TRect;
  hDWM: THandle;
begin   
  hDWM:=LoadLibrary('dwmapi.dll');
  try
    @DwmIsCompositionEnabled:=GetProcAddress(hDWM,'DwmIsCompositionEnabled');
    if @DwmIsCompositionEnabled<>nil then
        DwmIsCompositionEnabled(@Aero);
    if Aero then begin
      Area:=Rect(-1,-1,-1,-1);
      Color:=clBlack;
      @DwmExtendFrameIntoClientArea:=GetProcAddress(hDWM,'DwmExtendFrameIntoClientArea');
      if @DwmExtendFrameIntoClientArea<>nil then
          DwmExtendFrameIntoClientArea(Handle,@Area);
  
    end
    else ShowMessage('Aero is Disabled');
  finally
    FreeLibrary(hDWM);
  end;
end;

That might be enough on Windows Vista/7, but on Windows 8/8.1 it won’t do anything as well on Windows 10. However, since aero glass is available in Windows 10,  we need to call the undocumented SetWindowCompositionAttribute function from user32.dll in order to enable aero glass, because it is not entirely backward compatible, but don’t worry, it is very easy to use that function:

type
  AccentPolicy = packed record
    AccentState: Integer;
    AccentFlags: Integer;
    GradientColor: Integer;
    AnimationId: Integer;
  end;
  
  WindowCompositionAttributeData = packed record
    Attribute: Cardinal;
    Data: Pointer;
    SizeOfData: Integer;
  end;
 var
  SetWindowCompositionAttribute:function (hWnd: HWND; var data: WindowCompositionAttributeData):integer; stdcall;
//...

procedure TForm1.EnableBlur;
const
  WCA_ACCENT_POLICY = 19;
  ACCENT_ENABLE_BLURBEHIND = 3;
var
  dwm10: THandle;
  data: WindowCompositionAttributeData;
  accent: AccentPolicy;
begin      
      dwm10 := LoadLibrary('user32.dll');
      try
        @SetWindowCompositionAttribute := GetProcAddress(dwm10, 'SetWindowCompositionAttribute');
        if @SetWindowCompositionAttribute <> nil then
        begin
          accent.AccentState := ACCENT_ENABLE_BLURBEHIND;
          data.Attribute := WCA_ACCENT_POLICY;
          data.SizeOfData := SizeOf(accent);
          data.Data := @accent;
          SetWindowCompositionAttribute(Handle, data);
        end
        else
        begin
          ShowMessage('Not found Windows 10 SetWindowCompositionAttribute in user32.dll');
        end;
      finally
        FreeLibrary(dwm10);
      end;
end;

How to use:
On a new VCL project we just enable GlassFrame property with rect = (-1,-1,-1,-1) to avoid borders glitches, and BorderStyle = bsSingle.

You can add your preferred components too. The Form might need to be set Double Buffered in order to show some components, the same old Aero Glass issue from Windows 7/Vista on VCL components.
After that call the EnableBlur procedure from Form’s OnCreate event:

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsSingle;
  BorderIcons := [biSystemMenu, biMinimize];
  EnableBlur;
end;

As you might notice, I’ve changed the Form’s border properties programmatically, specially the border icons, because if we use biMaximize it will show the window’s aero glass using the maximum size.

I’m not sure why, but if we set the same border icons in the properties field, it doesn’t fix that issue. However,  setting it programmatically removes that extra area.


You can play with settings: bsSizable for instance might allow to resize the window, double buffered settings, custom components, etc.
Here is the complete code (with Image, Label and Button component added as shown in the snapshots).

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure EnableBlur;
  public
    { Public declarations }
  end;

  AccentPolicy = packed record
    AccentState: Integer;
    AccentFlags: Integer;
    GradientColor: Integer;
    AnimationId: Integer;
  end;

  WindowCompositionAttributeData = packed record
    Attribute: Cardinal;
    Data: Pointer;
    SizeOfData: Integer;
  end;


var
  Form1: TForm1;
  SetWindowCompositionAttribute:function (hWnd: HWND; var data: WindowCompositionAttributeData):integer; stdcall;
implementation

{$R *.dfm}


procedure TForm1.EnableBlur;
const
  WCA_ACCENT_POLICY = 19;
  ACCENT_ENABLE_BLURBEHIND = 3;
var
  dwm10: THandle;
  data: WindowCompositionAttributeData;
  accent: AccentPolicy;
begin
      dwm10 := LoadLibrary('user32.dll');
      try
        @SetWindowCompositionAttribute := GetProcAddress(dwm10, 'SetWindowCompositionAttribute');
        if @SetWindowCompositionAttribute <> nil then
        begin
          accent.AccentState := ACCENT_ENABLE_BLURBEHIND;
          data.Attribute := WCA_ACCENT_POLICY;
          data.SizeOfData := SizeOf(accent);
          data.Data := @accent;
          SetWindowCompositionAttribute(Handle, data);
        end
        else
        begin
          ShowMessage('Not found Windows 10 SetWindowCompositionAttribute in user32.dll');
        end;
      finally
        FreeLibrary(dwm10);
      end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsSingle;
  BorderIcons := [biSystemMenu, biMinimize];
  EnableBlur;
end;

end.

Finally, some links to articles and source codes which use this undocumented Windows 10 API and DWM related that might interest you.

• SetWindowCompositionAttribute API http://undoc.airesoft.co.uk/user32.dll/SetWindowCompositionAttribute.php
• GetWindowCompositionAttribute and WINCOMPATTRDATA details http://undoc.airesoft.co.uk/user32.dll/GetWindowCompositionAttribute.php
• Adding the “Aero Glass” blur to your Windows 10 apps by Rafael Rivera for C# using WPF
• User32 definitions code in Lua and Windows
• The Road to Delphi DWM examples
• EarTrumpet source code which shows a fancy popup control similar to Windows 10’s volume trayicon’s popup

If you know further improvements to the code, references, anything valuable, feel free to share them in the comments.

[UPDATE]  I added more details related to colorization at StackOverflow