Как установить цвет смешивания стекла в Windows 10?
Использование недокументированного SetWindowCompositionAttribute API на Windows 10, возможно включить стекло для окна. Стекло белое или прозрачное, как показано на этом скриншоте:
Тем не менее, меню "Пуск" Windows 10 и центр уведомлений, в которых также используется стекло, смешиваются с акцентным цветом следующим образом:
Как это сделать?
исследования
Цвет акцента в следующих примерах светло-фиолетовый - вот скриншот из приложения "Настройки":
Структура AccentPolicy, определенная в этом примере кода, имеет поля состояния акцента, флаги и цвета градиента:
AccentPolicy = packed record
AccentState: Integer;
AccentFlags: Integer;
GradientColor: Integer;
AnimationId: Integer;
end;
и состояние может иметь любое из следующих значений:
ACCENT_ENABLE_GRADIENT = 1;
ACCENT_ENABLE_TRANSPARENTGRADIENT = 2;
ACCENT_ENABLE_BLURBEHIND = 3;
Обратите внимание, что первые два из них были найдены в этом github gist.
Третий работает нормально - это позволяет стекло. Из двух других
- В результате ACCENT_ENABLE_GRADIENT окно становится полностью серым, независимо от того, что за ним. Нет прозрачности или эффекта стекла, но нарисованный цвет окна рисуется DWM, а не приложением.
- ACCENT_ENABLE_TRANSPARENTGRADIENT приводит к окну, которое полностью окрашено цветом акцента, независимо от того, что стоит за ним. Нет прозрачности или эффекта стекла, но нарисованный цвет окна рисуется DWM, а не приложением.
Так что это близко, и похоже, что некоторые из всплывающих окон, такие как апплет управления громкостью, используют.
Значения нельзя объединять или редактировать вместе, и значение поля GradientColor не имеет никакого эффекта, за исключением того, что оно должно быть ненулевым.
Рисование непосредственно на стекле с включенным окном приводит к очень странному смешиванию. Здесь он заполняет клиентскую область красным (0x000000FF в формате ABGR):
и любая ненулевая альфа, например, 0xAA0000FF, приводит к отсутствию цвета вообще:
Не соответствует внешний вид меню "Пуск" или области уведомлений.
Как эти окна делают это?
3 ответа
Поскольку формы GDI в Delphi не поддерживают альфа-каналы (если только не используются альфа-многослойные окна, которые могут не подходить), обычно черный цвет считается прозрачным, если компонент не поддерживает альфа-каналы.
tl; dr Просто используйте ваш класс TTransparentCanvas, .Rectangle(0,0,Width+1,Height+1,222) используя цвет, полученный с помощью DwmGetColorizationColor, который можно смешать с темным цветом.
Далее будет использоваться компонент TImage.
Я собираюсь использовать TImage и TImage32 (Graphics32), чтобы показать разницу с альфа-каналами. Это форма без границ, потому что границы не принимают нашу раскраску.
Как вы можете видеть, левый использует TImage1 и на него воздействует Aero Glass, а правый использует TGraphics32, который позволяет накладывать непрозрачные цвета (без полупрозрачности).
Теперь мы будем использовать TImage1 с полупрозрачным PNG, который мы можем создать с помощью следующего кода:
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 с цветом Accent на 50%: 
Есть и другие вещи, которые вы, возможно, захотите добавить, например, определение изменения цвета акцента и автоматическое обновление цвета нашего приложения, например:
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;
Чтобы поддерживать согласованность с настройками меню "Пуск" Windows 10, вы можете прочитать реестр, чтобы выяснить, является ли панель задач /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 = $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.
Вот исходный код и демонстрационный бинарный код, надеюсь, это поможет.
Я надеюсь, что есть лучший способ, и если есть, пожалуйста, дайте нам знать.
Кстати, на C# и WPF это проще, но эти приложения очень медленно работают при холодном запуске.
[ Обновление бонуса ] В качестве альтернативы в обновлении Windows 10 за апрель 2018 года или более поздней версии (может работать при обновлении Fall Creators), вместо этого можно использовать акриловое размытие, его можно использовать следующим образом:
const ACCENT_ENABLE_ACRYLICBLURBEHIND = 4;
...
accent.AccentState := ACCENT_ENABLE_ACRYLICBLURBEHIND;
// $AABBGGRR
accent.GradientColor := (opacity SHL 24) or (clRed);
Но это может не сработать, если выполняется WM_NCCALCSIZE, т.е. будет работать только на bsNone стиль границы или WM_NCALCSIZE исключены. Обратите внимание, что раскрашивание включено, нет необходимости рисовать вручную.
AccentPolicy.GradientColor имеет эффект, когда вы играете с AccentPolicy.AccentFlagsЯ нашел эти значения:
2- заполняет окноAccentPolicy.GradientColor- что вам нужно
4- делает область справа и нижней части окна размытой (странно)6- комбинация выше: заполняет весь экранAccentPolicy.GradientColorи размывает область как4
Установить AccentPolicy.GradientColor свойства, вам понадобятся системные цвета ActiveCaption и InactiveCaption. Я бы попробовал предложение Рафаэля использовать GetImmersiveColor* семейство функций. Также есть вопрос по Vista/7.
Примечание: я попробовал рисовать с помощью GDI+ и увидел, что FillRectangle() неправильно работает со стеклом, когда brush.alpha==0xFF ( обходные пути здесь). Внутренние прямоугольники имеют brush.alpha==0xFE на обоих скриншотах из-за этой ошибки.
Примечание к скриншотам: GradientColor==0x80804000, это не должно быть предварительно умножено, просто совпадение.
Просто добавьте прозрачный цветной компонент в форму. У меня есть самописный компонент, такой как TPanel (на Delphi).
Здесь Альфа = 40%:
