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?
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: