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;
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;
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;
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.
- 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
No hay comentarios:
Publicar un comentario