jueves, 23 de julio de 2015

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


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.
Windows-10-Aero-Glass
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.
GlassFrame
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.
Blur-Error
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.

Windows-10-Blur
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.

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

0 comentarios:

Publicar un comentario