如何在Windows 10上设置玻璃混合颜色？
在Windows 10上使用undocumented SetWindowCompositionAttribute API，可以为窗口启用玻璃。玻璃是白色或透明的，如截图所示：
但是，Windows 10“开始”菜单和通知中心都使用了玻璃，两者都混合了强调色，如下所示：
它是如何做到的？
调查
以下示例中的强调色为浅紫色 - 这是设置应用中的屏幕截图：
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导致窗口完全变灰，无论其背后是什么。没有透明度或玻璃效果，但绘制的窗口颜色是由DWM绘制的，而不是由应用程序绘制的。
- ACCENT_ENABLE_TRANSPARENTGRADIENT导致窗口完全涂上强调色，无论其背后是什么。没有透明度或玻璃效果，但绘制的窗口颜色是由DWM绘制的，而不是由应用程序绘制的。
所以这已经越来越近了，它似乎是一些像音量控制小程序一样的弹出窗口。
这些值不能一起排序，并且GradientColor字段的值无效，除非它必须为非零。
直接在支持玻璃的窗口上绘图会导致非常奇怪的混合。这里用红色填充客户区（ABGR格式为0x000000FF）：
任何非零alpha，例如0xAA0000FF，都不会产生任何颜色：
既不匹配“开始”菜单或通知区域的外观。
那些窗户是如何做到的？
3 个答案:
答案 0 :(得分：12)
由于Delphi上的GDI表单不支持alpha通道（除非使用alpha分层窗口，这可能不合适），通常黑色将被视为透明色，除非组件支持alpha通道。
tl; dr 只需使用TTransparentCanvas课程String::length，使用DwmGetColorizationColor获得的颜色blend颜色。
以下将使用TImage组件。
我将使用TImage和TImage32（Graphics32）来显示与alpha通道的差异。这是一种无边框形式，因为边框不接受我们的着色。
如您所见，左侧是使用TImage1，受Aero Glass影响，右侧使用TGraphics32，可以覆盖不透明的颜色（没有半透明）。
现在，我们将使用带有半透明PNG的TImage1，我们可以使用以下代码创建：
.Rectangle(0,0,Width+1,Height+1,222)我们需要在表单中添加另一个TImage组件并将其发回，以便其他组件不会低于它。
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;
这就是我们的表单看起来像开始菜单的方式。
现在，为了获得强调色，请使用已在SetAlphaColorPicture(clblack, 200, Image1.Picture, 10,10 );
Image1.Align := alClient;
Image1.Stretch := True;
Image1.Visible := True;
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;
这是将clBlack与Accent颜色混合50％的结果：
您可能还想添加其他内容，例如检测重音颜色何时更改并自动更新应用颜色，例如：
//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);
为了保持与Windows 10开始菜单设置的一致性，您可以阅读注册表以查明Taskbar / StartMenu是否为半透明（启用）并且启用开始菜单以使用强调颜色或仅使用黑色背景来执行此操作所以这把钥匙会告诉我们：
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;
这是完整的代码，你需要TImage1，TImage2，用于着色，其他的不是可选的。
'SOFTWARE\Microsoft\Windows\CurrentVersion\Themes\Personalize'
ColorPrevalence = 1 or 0 (enabled / disabled)
EnableTransparency = 1 or 0
这是source code and demo binary希望它有所帮助。
我希望有更好的方法，如果有，请告诉我们。
在C＃和WPF上BTW它更容易，但这些应用程序在冷启动时非常慢。[奖金更新] 或者在Windows 2010年4月更新或更新（可能适用于秋季创作者更新），您可以使用后面的丙烯酸模糊，它可以使用如下：
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.
但是如果执行WM_NCCALCSIZE，这可能不起作用，即只能在const ACCENT_ENABLE_ACRYLICBLURBEHIND = 4;
...
accent.AccentState := ACCENT_ENABLE_ACRYLICBLURBEHIND;
// $AABBGGRR
accent.GradientColor := (opacity SHL 24) or (clRed);
边框样式或WM_NCALCSIZE上工作。请注意，包含着色，无需手动绘制。
答案 1 :(得分：8)
当你使用
AccentPolicy.GradientColor时， AccentPolicy.AccentFlags有效，我找到了这些值：
-
2- 使用AccentPolicy.GradientColor填充窗口 - 您需要的内容
-
4- 使窗口右侧和底部的区域模糊（奇怪） -
6- 上述组合：使用AccentPolicy.GradientColor填充整个屏幕并模糊4之类的区域
要设置AccentPolicy.GradientColor属性，您需要ActiveCaption和InactiveCaption系统颜色。我会尝试拉斐尔建议使用GetImmersiveColor*系列函数。 Vista / 7还有一个question。
注意：我尝试使用GDI +进行绘制，并在FillRectangle()（workarounds here）时看到brush.alpha==0xFF与Glass一起工作不正常。由于这个错误，内部矩形在两个屏幕截图上都有brush.alpha==0xFE。
屏幕截图注释：GradientColor==0x80804000，它不必预先复制，只是巧合。
答案 2 :(得分：4)
只需在表单中添加透明的彩色组件即可。我有像TPanel这样的自写组件（在Delphi上）。
这里Alpha = 40％：
相关问题
- 你如何改变SketchFlow ComboBox的高度？
- 如何在Microsoft Expression Blend 4中以编程方式更改标签的文本颜色
- 如何设置Spark Icon ItemRenderer的背景颜色？
- 如何为ListPicker项设置所选颜色
- 如何在ListView for metro / WinRT应用程序的项目单击上设置不同的背景颜色？
- 如何设置ToggleSwitch的访问键？
- 如何在Windows 10上设置玻璃混合颜色？
- 如何以编程方式在Windows 10 Mobile上读/写注册表项？
- 如何根据用户在其上的位置设置网页的颜色？
- 如何在Windows 10上提高ChefDK命令的性能？
最新问题
- 我写了这段代码，但我无法理解我的错误
- 我无法从一个代码实例的列表中删除 None 值，但我可以在另一个实例中。为什么它适用于一个细分市场而不适用于另一个细分市场？
- 是否有可能使 loadstring 不可能等于打印？卢阿
- java中的random.expovariate()
- Appscript 通过会议在 Google 日历中发送电子邮件和创建活动
- 为什么我的 Onclick 箭头功能在 React 中不起作用？
- 在此代码中是否有使用“this”的替代方法？
- 在 SQL Server 和 PostgreSQL 上查询，我如何从第一个表获得第二个表的可视化
- 每千个数字得到
- 更新了城市边界 KML 文件的来源？