How do I create a acrylic blur effect in a VCL application?

Question

How do I create a acrylic blur effect like the one in UWP apps in a Delphi VCL application?

I tried using the following method I found here:

program DwmTest;
//Author  : Rodrigo Ruz 2009-10-26
{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils;

type
  DWM_BLURBEHIND = record
    dwFlags                 : DWORD;
    fEnable                 : BOOL;
    hRgnBlur                : HRGN;
    fTransitionOnMaximized  : BOOL;
  end;

//function to enable the glass effect
function DwmEnableBlurBehindWindow(hWnd : HWND; const pBlurBehind : DWM_BLURBEHIND) : HRESULT; stdcall; external  'dwmapi.dll' name 'DwmEnableBlurBehindWindow';
//get the handle of the console window
function GetConsoleWindow: HWND; stdcall; external kernel32 name 'GetConsoleWindow';

function DWM_EnableBlurBehind(hwnd : HWND; AEnable: Boolean; hRgnBlur : HRGN = 0; ATransitionOnMaximized: Boolean = False; AFlags: Cardinal = 1): HRESULT;
var
  pBlurBehind : DWM_BLURBEHIND;
begin
  pBlurBehind.dwFlags:=AFlags;
  pBlurBehind.fEnable:=AEnable;
  pBlurBehind.hRgnBlur:=hRgnBlur;
  pBlurBehind.fTransitionOnMaximized:=ATransitionOnMaximized;
  Result:=DwmEnableBlurBehindWindow(hwnd, pBlurBehind);
end;

begin
  try
    DWM_EnableBlurBehind(GetConsoleWindow(), True);
    Writeln('Test of glass effect');
    Readln;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

Unfortunately this only makes the windows a white-transparent appearance without any kind of blurring.

How can I achieve this effect?

Answer 1

First, you don't need to declare the DWM APIs yourself, since they are already declared in the DwmApi unit. Also, GetConsoleWindow is declared in the Windows unit.

Second, the effect your code is trying to apply is not the UWP effect; instead, it is the Windows Vista Aero effect.

And this does work for me:

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  Windows, System.SysUtils, DwmApi;

function DWM_EnableBlurBehind(hwnd: HWND; AEnable: Boolean; hRgnBlur: HRGN = 0; ATransitionOnMaximized: Boolean = False; AFlags: Cardinal = 1): HRESULT;
var
  pBlurBehind: DWM_BLURBEHIND;
begin
  pBlurBehind.dwFlags := AFlags;
  pBlurBehind.fEnable := AEnable;
  pBlurBehind.hRgnBlur := hRgnBlur;
  pBlurBehind.fTransitionOnMaximized := ATransitionOnMaximized;
  Result := DwmEnableBlurBehindWindow(hwnd, pBlurBehind);
end;

begin
  DWM_EnableBlurBehind(GetConsoleWindow(), True);
  Writeln('Hello, Aero!');
  Readln;
end.

So why doesn't it work for you? Probably, you are using Windows 8 or later. In these systems, this effect has been removed.

Obviously, when you found this code, your first instinct was to look up the documentation for the DwmEnableBlurBehindWindow function. But apparently you missed the warning a page down: