如何在 Windows 10 上设置玻璃混合颜色？

Question

在 Windows 10 上使用 undocumented SetWindowCompositionAttribute API，可以为 window 启用玻璃。玻璃是白色或透明的，如屏幕截图所示：

然而，Windows10 开始菜单和通知中心，同样使用玻璃，都与强调色相融合，像这样：

它是怎么做到的？

调查

以下示例中的强调色是浅紫色 - 这是“设置”应用的屏幕截图：

AccentPolicy structure defined in this example code 具有重音状态、标志和渐变颜色字段：

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

并且状态可以具有以下任何值：

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

请注意，前两个是在 this github gist 上找到的。

第三个工作正常 - 启用玻璃。在另外两个中，

ACCENT_ENABLE_GRADIENT 导致 window 完全变灰，不管它背后是什么。没有透明度或玻璃效果，但正在绘制的 window 颜色是由 DWM 绘制的，而不是由应用程序绘制的。

ACCENT_ENABLE_TRANSPARENTGRADIENT 导致 window 完全用强调色绘制，无论其背后是什么。没有透明度或玻璃效果，但正在绘制的 window 颜色是由 DWM 绘制的，而不是由应用程序绘制的。

所以这越来越接近了，这似乎是一些弹出窗口 windows 像音量控制小程序所使用的。

不能对这些值进行或运算，GradientColor 字段的值除了必须为非零外没有任何影响。

直接在支持玻璃的 window 上绘制会导致非常奇怪的混合。这里用红色填充客户区（ABGR 格式为 0x000000FF）：

和任何非零 alpha，例如 0xAA0000FF，结果根本没有颜色：

与“开始”菜单或通知区域的外观都不匹配。

那些windows是怎么做到的？

Answer 1

只需在窗体中添加透明色组件即可。我有像 TPanel 这样的自写组件（在 Delphi）。

此处 Alpha = 40%：

Answer 2

由于 Delphi 上的 GDI 表单不支持 alpha 通道（除非使用 alpha layered windows，这可能不合适），通常黑色会被视为透明的，除非该组件支持 alpha 通道。

tl;dr 只需使用深色 TTransparentCanvas class, .Rectangle(0,0,Width+1,Height+1,222), using the color obtained with DwmGetColorizationColor that you could blend。

以下将使用TImage组件代替

我将使用 TImage 和 TImage32 (Graphics32) 来显示 alpha 通道的区别。这是一个无边框的表单，因为边框不接受我们的着色。

如您所见，左侧使用的是 TImage1 并受 Aero Glass 影响，右侧使用的是 TGraphics32，它允许使用不透明颜色（非半透明）进行叠加。

现在，我们将使用带有半透明 PNG 的 TImage1，我们可以使用以下代码创建它：

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;

我们需要将另一个 TImage 组件添加到我们的表单并将其发回，这样其他组件就不会在它下面。

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

这就是我们的表单看起来像“开始”菜单的样子。

现在，要获得强调色，请使用 DwmGetColorizationColor，它已在 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;

但是，该颜色不会像“开始”菜单中显示的那样深。

因此我们需要将强调色与深色混合：

//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);

这是将 clBlack 与强调色混合 50% 的结果：

您可能还想添加其他内容，例如检测强调色何时更改并自动更新我们的应用程序颜色，例如：

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

为了与Windows10开始菜单设置保持一致，您可以阅读注册表以了解Taskbar/StartMenu是否是半透明的（启用）以及是否启用开始菜单使用强调色或者只是黑色背景，这样做这个键会告诉我们：

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

这是完整的代码，你需要TImage1，TImage2，用于着色，其他的不是可选的。

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 = ;
  DrawTopBorder = ;
  DrawRightBorder = ;
  DrawBottomBorder = 0;
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 = 20;
begin
  if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then
  begin
      UpdateColorization;
  end;
  inherited WndProc(Message);

end;

initialization
  SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute');
end.

这是source code and demo binary希望对您有所帮助。

希望有更好的方法，如果有请告诉我们。

顺便说一句，在 C# 和 WPF 上更容易，但这些应用程序在冷启动时非常慢。

[奖金更新] 或者在 Windows 2018 年 4 月 10 日更新或更新版本（可能适用于 Fall Creators Update），您可以使用 Acrylic blur behind 来代替，它可以按如下方式使用：

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

但是如果执行 WM_NCCALCSIZE 这可能不起作用，即仅适用于 bsNone 边框样式或避免 WM_NCALCSIZE。请注意，包含着色，无需手动绘制。

Answer 3

AccentPolicy.GradientColor 在玩 AccentPolicy.AccentFlags 时有效，我发现这些值：

2 - 用 AccentPolicy.GradientColor 填充 window - 你需要什么
4 - 使 window 右侧和底部的区域模糊（奇怪）
6 - 以上组合：用 AccentPolicy.GradientColor 填充整个屏幕并模糊区域 4

要设置 AccentPolicy.GradientColor 属性，您需要 ActiveCaption 和 InactiveCaption 系统颜色。 ~~我会尝试 Rafael 的建议，使用 GetImmersiveColor* 函数族~~ （请参阅更新）。 Vista/7.

还有一个 question

注意：我尝试使用 GDI+ 进行绘图，发现 FillRectangle() 在 brush.alpha==0xFF (workarounds here) 时无法与 Glass 一起使用。由于这个错误，内部矩形在两个屏幕截图上都有 brush.alpha==0xFE。

截图注：GradientColor==0x80804000，不用预乘，纯属巧合

更新： 要获得强调色，您可以使用 C++/WinRT - 这是一种有据可查的方法，因此是 Windows 10:

的首选方法

#include <winrt/Windows.UI.ViewManagement.h> // may need "Microsoft.Windows.CppWinRT" NuGet package
...
using namespace winrt::Windows::UI::ViewManagement;
winrt::Windows::UI::Color accent = UISettings{}.GetColorValue(UIColorType::Accent);

如何在 Windows 10 上设置玻璃混合颜色？

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

winapi

windows-10

aero

dwm

aero-glass

调查