How do you set the glass blend colour on Windows 10?

Question

Using the undocumented SetWindowCompositionAttribute API on Windows 10, it's possible to enable glass for a window. The glass is white or clear, as seen in this screenshot:

However, the Windows 10 Start menu and the notification center, which both also uses glass, both blend with the accent colour, like so:

How does it do it?

Investigations

The accent colour in the following examples is a light purple - here's a screenshot from the Settings app:

The AccentPolicy structure defined in this example code has accent state, flags and gradient color fields:

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

and the state can have any of these values:

  ACCENT_ENABLE_GRADIENT = 1;   ACCENT_ENABLE_TRANSPARENTGRADIENT = 2;   ACCENT_ENABLE_BLURBEHIND = 3; 

Note that the first two of these were found on this github gist.

The third works fine - that enables glass. Of the other two,

• ACCENT_ENABLE_GRADIENT results in a window that is completely gray, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.

• ACCENT_ENABLE_TRANSPARENTGRADIENT results in a window that is painted completely with the accent colour, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.

So this is getting close, and it seems to be what some of the popup windows like the volume control applet use.

The values can't be or-ed together, and the value of the GradientColor field has no effect except that it must be non-zero.

Drawing directly on a glass-enabled window results in very odd blending. Here it's filling the client area with red (0x000000FF in ABGR format):

and any non-zero alpha, eg 0xAA0000FF, results in no colour at all:

Neither match the look of the Start menu or notification area.

How do those windows do it?

Answer 1

Since GDI forms on Delphi don't support alpha channels (unless using alpha layered windows, which might not be suitable), commonly the black color will be taken as the transparent one, unless the component supports alpha channels.

tl;dr Just use your TTransparentCanvas class, .Rectangle(0,0,Width+1,Height+1,222), using the color obtained with DwmGetColorizationColor that you could blend with a dark color.

The following will use TImage component instead.

I'm going to use a TImage and TImage32 (Graphics32) to show the difference with alpha channels. This is a borderless form, because borders won't accept our colorization.

As you can see, the left one is using TImage1 and is affected by Aero Glass, and the right one is using TGraphics32, which allows to overlay with opaque colors (no translucent).

Now, we will be using a TImage1 with a translucent PNG that we can create with the following code:

procedure SetAlphaColorPicture(   const Col: TColor;   const Alpha: Integer;   Picture: TPicture;   const _width: Integer;   const _height: Integer   ); var   png: TPngImage;   x,y: integer;   sl: pByteArray; begin    png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);   try      png.Canvas.Brush.Color := Col;     png.Canvas.FillRect(Rect(0,0,_width,_height));      for y := 0 to png.Height - 1 do     begin       sl := png.AlphaScanline[y];       FillChar(sl^, png.Width, Alpha);     end;      Picture.Assign(png);    finally     png.Free;   end; end; 

We need to add another TImage component to our form and send it back so other components won't be below it.

SetAlphaColorPicture(clblack, 200, Image1.Picture, 10,10  ); Image1.Align := alClient; Image1.Stretch := True; Image1.Visible := True; 

And that's is how our form will look like the Start Menu.

Now, to get the accent color use DwmGetColorizationColor, which is already defined in DwmAPI.pas

function TForm1.GetAccentColor:TColor; var   col: cardinal;   opaque: longbool;   newcolor: TColor;   a,r,g,b: byte; begin   DwmGetColorizationColor(col, opaque);   a := Byte(col shr 24);   r := Byte(col shr 16);   g := Byte(col shr 8);   b := Byte(col);    newcolor := RGB(       round(r*(a/255)+255-a),       round(g*(a/255)+255-a),       round(b*(a/255)+255-a)   );    Result := newcolor;  end; 

However, that color won't be dark enough as shown by the Start Menu.

So we need to blend the accent color with a dark color:

//Credits to Roy M Klever http://rmklever.com/?p=116 function TForm1.BlendColors(Col1, Col2: TColor; A: Byte): TColor; var   c1,c2: LongInt;   r,g,b,v1,v2: byte; begin   A := Round(2.55 * A);   c1 := ColorToRGB(Col1);   c2 := ColorToRGB(Col2);   v1 := Byte(c1);   v2 := Byte(c2);   r := A * (v1 - v2) shr 8 + v2;   v1 := Byte(c1 shr 8);   v2 := Byte(c2 shr 8);   g := A * (v1 - v2) shr 8 + v2;   v1 := Byte(c1 shr 16);   v2 := Byte(c2 shr 16);   b := A * (v1 - v2) shr 8 + v2;   Result := (b shl 16) + (g shl 8) + r; end;  ...  SetAlphaColorPicture(BlendColors(GetAccentColor, clBlack, 50) , 222, Image1.Picture, 10, 10); 

And this is the result blending clBlack with the Accent color by 50%:

There are other things that you might want to add, like for example detecting when the accent color changes and automatically update our app color too, for example:

procedure WndProc(var Message: TMessage);override; ... procedure TForm1.WndProc(var Message: TMessage); const   WM_DWMCOLORIZATIONCOLORCHANGED = $0320; begin   if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then   begin       // here we update the TImage with the new color   end;   inherited WndProc(Message); end;    

To maintain consistency with Windows 10 start menu settings, you can read the registry to find out if the Taskbar/StartMenu is translucent (enabled) and the start menu is enabled to use the accent color or just a black background, to do so this keys will tell us:

'SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize' ColorPrevalence = 1 or 0 (enabled / disabled) EnableTransparency = 1 or 0 

This is the full code, you need TImage1, TImage2, for the colorization, the other ones are not optional.

unit Unit1;  interface  uses   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, GR32_Image, DWMApi, GR32_Layers,   Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.pngimage, Registry;  type   TForm1 = class(TForm)     Button1: TButton;     Image1: TImage;     Image3: TImage;     Image321: TImage32;     procedure FormCreate(Sender: TObject);     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;       Shift: TShiftState; X, Y: Integer);     procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;       Shift: TShiftState; X, Y: Integer);     procedure Button1Click(Sender: TObject);   private     { Private declarations }     function TaskbarAccented:boolean;     function TaskbarTranslucent:boolean;     procedure EnableBlur;     function GetAccentColor:TColor;     function BlendColors(Col1, Col2: TColor; A: Byte): TColor;     procedure WndProc(var Message: TMessage);override;     procedure UpdateColorization;   public     { Public declarations }   end;    AccentPolicy = packed record     AccentState: Integer;     AccentFlags: Integer;     GradientColor: Integer;     AnimationId: Integer;   end;    TWinCompAttrData = packed record     attribute: THandle;     pData: Pointer;     dataSize: ULONG;   end;   var   Form1: TForm1;  var   SetWindowCompositionAttribute: function (Wnd: HWND; const AttrData: TWinCompAttrData): BOOL; stdcall = Nil;  implementation  {$R *.dfm}      procedure SetAlphaColorPicture(       const Col: TColor;       const Alpha: Integer;       Picture: TPicture;       const _width: Integer;       const _height: Integer       );     var       png: TPngImage;       x,y: integer;       sl: pByteArray;     begin        png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);       try          png.Canvas.Brush.Color := Col;         png.Canvas.FillRect(Rect(0,0,_width,_height));         for y := 0 to png.Height - 1 do         begin           sl := png.AlphaScanline[y];           FillChar(sl^, png.Width, Alpha);         end;          Picture.Assign(png);        finally         png.Free;       end;     end;  procedure TForm1.Button1Click(Sender: TObject); begin   Close; end;  procedure TForm1.EnableBlur; const   WCA_ACCENT_POLICY = 19;   ACCENT_ENABLE_BLURBEHIND = 3;   DrawLeftBorder = $20;   DrawTopBorder = $40;   DrawRightBorder = $80;   DrawBottomBorder = $100; var   dwm10: THandle;   data : TWinCompAttrData;   accent: AccentPolicy; begin        dwm10 := LoadLibrary('user32.dll');       try         @SetWindowCompositionAttribute := GetProcAddress(dwm10, 'SetWindowCompositionAttribute');         if @SetWindowCompositionAttribute <> nil then         begin           accent.AccentState := ACCENT_ENABLE_BLURBEHIND ;           accent.AccentFlags := DrawLeftBorder or DrawTopBorder or DrawRightBorder or DrawBottomBorder;            data.Attribute := WCA_ACCENT_POLICY;           data.dataSize := SizeOf(accent);           data.pData := @accent;           SetWindowCompositionAttribute(Handle, data);         end         else         begin           ShowMessage('Not found Windows 10 blur API');         end;       finally         FreeLibrary(dwm10);       end;  end;  procedure TForm1.FormCreate(Sender: TObject); var   BlendFunc: TBlendFunction;   bmp: TBitmap; begin   DoubleBuffered := True;   Color := clBlack;   BorderStyle := bsNone;   if TaskbarTranslucent then     EnableBlur;    UpdateColorization;   (*BlendFunc.BlendOp := AC_SRC_OVER;   BlendFunc.BlendFlags := 0;   BlendFunc.SourceConstantAlpha := 96;   BlendFunc.AlphaFormat := AC_SRC_ALPHA;   bmp := TBitmap.Create;   try     bmp.SetSize(Width, Height);     bmp.Canvas.Brush.Color := clRed;     bmp.Canvas.FillRect(Rect(0,0,Width,Height));     Winapi.Windows.AlphaBlend(Canvas.Handle, 50,50,Width, Height,       bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, BlendFunc);   finally     bmp.Free;   end;*) end;  procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;   Shift: TShiftState; X, Y: Integer); begin   ReleaseCapture;   Perform(WM_SYSCOMMAND, $F012, 0); end;  procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;   Shift: TShiftState; X, Y: Integer); begin    ReleaseCapture;   Perform(WM_SYSCOMMAND, $F012, 0); end;   function TForm1.TaskbarAccented: boolean; var   reg: TRegistry; begin   Result := False;   reg := TRegistry.Create;   try     reg.RootKey := HKEY_CURRENT_USER;     reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize');     try       if reg.ReadInteger('ColorPrevalence') = 1 then       Result := True;     except       Result := False;     end;     reg.CloseKey;    finally     reg.Free;   end; end;  function TForm1.TaskbarTranslucent: boolean; var   reg: TRegistry; begin   Result := False;   reg := TRegistry.Create;   try     reg.RootKey := HKEY_CURRENT_USER;     reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize');     try       if reg.ReadInteger('EnableTransparency') = 1 then       Result := True;     except       Result := False;     end;     reg.CloseKey;    finally     reg.Free;   end; end;  procedure TForm1.UpdateColorization; begin   if TaskbarTranslucent then   begin     if TaskbarAccented then       SetAlphaColorPicture(BlendColors(GetAccentColor, clBlack, 50) , 222, Image1.Picture, 10, 10)     else       SetAlphaColorPicture(clblack, 222, Image1.Picture, 10,10  );     Image1.Align := alClient;     Image1.Stretch := True;     Image1.Visible := True;   end   else     Image1.Visible := False;  end;  function TForm1.GetAccentColor:TColor; var   col: cardinal;   opaque: longbool;   newcolor: TColor;   a,r,g,b: byte; begin   DwmGetColorizationColor(col, opaque);   a := Byte(col shr 24);   r := Byte(col shr 16);   g := Byte(col shr 8);   b := Byte(col);     newcolor := RGB(       round(r*(a/255)+255-a),       round(g*(a/255)+255-a),       round(b*(a/255)+255-a)   );    Result := newcolor;   end;  //Credits to Roy M Klever http://rmklever.com/?p=116 function TForm1.BlendColors(Col1, Col2: TColor; A: Byte): TColor; var   c1,c2: LongInt;   r,g,b,v1,v2: byte; begin   A := Round(2.55 * A);   c1 := ColorToRGB(Col1);   c2 := ColorToRGB(Col2);   v1 := Byte(c1);   v2 := Byte(c2);   r := A * (v1 - v2) shr 8 + v2;   v1 := Byte(c1 shr 8);   v2 := Byte(c2 shr 8);   g := A * (v1 - v2) shr 8 + v2;   v1 := Byte(c1 shr 16);   v2 := Byte(c2 shr 16);   b := A * (v1 - v2) shr 8 + v2;   Result := (b shl 16) + (g shl 8) + r; end;  procedure TForm1.WndProc(var Message: TMessage); //const //  WM_DWMCOLORIZATIONCOLORCHANGED = $0320; begin   if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then   begin       UpdateColorization;   end;   inherited WndProc(Message);  end;  initialization   SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute'); end. 

Here is the source code and demo binary hope it helps.

I hope there is a better way, and if there is, please let us know.

BTW on C# and WPF it is easier, but those apps are very slow on cold start.

[Bonus Update] Alternatively on Windows 10 April 2018 Update or newer (might work on Fall Creators Update), you can use Acrylic blur behind instead, it can be used as follows:

const ACCENT_ENABLE_ACRYLICBLURBEHIND = 4; ... accent.AccentState := ACCENT_ENABLE_ACRYLICBLURBEHIND; // $AABBGGRR accent.GradientColor := (opacity SHL 24) or (clRed); 

But this might not work if WM_NCCALCSIZE is executed, i.e. will only work on bsNone border style or WM_NCALCSIZE avoided. Notice that colorizing is included, no need to paint manually.