winapi - muscle - ¿Cómo se establece el color de la mezcla de vidrio en Windows 10?

glass eu

Question

Al usar la API de SetWindowCompositionAttribute composición de SetWindowCompositionAttribute no documentada en Windows 10, es posible habilitar el vidrio para una ventana. El vidrio es blanco o claro, como se ve en esta captura de pantalla:

Sin embargo, el menú Inicio de Windows 10 y el centro de notificaciones, que también usan vidrio, se mezclan con el color de acento, de esta manera:

¿Cómo lo hace?

Investigaciones

El color de acento en los siguientes ejemplos es de color púrpura claro. Aquí hay una captura de pantalla de la aplicación Configuración:

La estructura de AccentPolicy definida en este código de ejemplo tiene acento, banderas y campos de color de degradado:

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

y el estado puede tener cualquiera de estos valores:

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

Tenga en cuenta que los dos primeros de estos se encontraron en este github gist .

El tercero funciona bien - eso permite el vidrio. De los otros dos,

• ACCENT_ENABLE_GRADIENT da como resultado una ventana que está completamente gris, independientemente de lo que haya detrás. No hay transparencia ni efecto de vidrio, pero el color de la ventana que se está dibujando está siendo dibujado por el DWM, no por la aplicación.

• ACCENT_ENABLE_TRANSPARENTGRADIENT da como resultado una ventana que se pinta completamente con el color de acento, independientemente de lo que haya detrás. No hay transparencia ni efecto de vidrio, pero el color de la ventana que se está dibujando está siendo dibujado por el DWM, no por la aplicación.

Así que esto se está acercando, y parece ser lo que usan algunas de las ventanas emergentes como el applet de control de volumen.

Los valores no pueden ser orados juntos, y el valor del campo GradientColor no tiene ningún efecto, excepto que debe ser distinto de cero.

Dibujar directamente en una ventana con vidrio resulta en una mezcla muy extraña. Aquí está llenando el área del cliente con rojo (0x000000FF en formato ABGR):

y cualquier alfa que no sea cero, por ejemplo, 0xAA0000FF, no produce ningún color:

Tampoco coinciden con el aspecto del menú Inicio o el área de notificación.

¿Cómo lo hacen esas ventanas?

Answer 1

Dado que los formularios GDI en Delphi no admiten canales alfa (a menos que se utilicen ventanas con capas alfa, lo que podría no ser adecuado), generalmente el color negro se tomará como transparente, a menos que el componente admita canales alfa.

tl; dr Simplemente use su clase TTransparentCanvas , .Rectangle(0,0,Width+1,Height+1,222) , usando el color obtenido con DwmGetColorizationColor que puede blend con un color oscuro.

Lo siguiente usará el componente TImage en su lugar.

Voy a usar un TImage y TImage32 (Graphics32) para mostrar la diferencia con los canales alfa. Esta es una forma sin bordes, porque los bordes no aceptarán nuestra colorización.

Como puede ver, el izquierdo está usando TImage1 y Aero Glass, y el derecho está usando TGraphics32, que permite superponer con colores opacos (no translúcidos).

Ahora, usaremos un TImage1 con un PNG translúcido que podemos crear con el siguiente código:

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;

Necesitamos agregar otro componente de TImage a nuestro formulario y enviarlo de vuelta para que otros componentes no estén debajo de él.

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

Y así es como se verá nuestro formulario como el Menú de Inicio.

Ahora, para obtener el color de acento use DwmGetColorizationColor , que ya está definido en 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;

Sin embargo, ese color no será lo suficientemente oscuro como se muestra en el menú Inicio.

Así que tenemos que mezclar el color de acento con un color oscuro:

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

Y este es el resultado que combina clBlack con el color Accent en un 50%:

Es posible que desee agregar otras cosas, como por ejemplo detectar cuándo cambia el color de acento y actualizar automáticamente el color de nuestra aplicación, por ejemplo:

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; 

Para mantener la coherencia con la configuración del menú de inicio de Windows 10, puede leer el registro para averiguar si la Barra de tareas / StartMenu es translúcida (habilitada) y el menú de inicio está habilitado para usar el color de acento o solo un fondo negro, para hacerlo, estas teclas nos dirá:

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

Este es el código completo, necesita TImage1, TImage2, para la colorización, los otros no son opcionales.

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.

Aquí está el código fuente y la demo binario de la esperanza que ayuda.

Espero que haya una mejor manera, y si la hay, háganoslo saber.

BTW en C # y WPF es más fácil, pero esas aplicaciones son muy lentas en el arranque en frío.

[ Actualización adicional ] Como alternativa, en la actualización de Windows 10 de abril de 2018 o más reciente (podría funcionar en la actualización de Fall Creators), puede usar Acrylic borroso detrás, puede usarse de la siguiente manera:

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

Pero esto podría no funcionar si se ejecuta WM_NCCALCSIZE, es decir, solo funcionará en el estilo de borde bsNone o se evitará WM_NCALCSIZE. Tenga en cuenta que el coloreado está incluido, no es necesario pintarlo manualmente.

Answer 2

Simplemente añada el componente de color transparente al formulario. Tengo un componente de escritura propia como TPanel (en Delphi).

Aquí Alfa = 40%:

Answer 3

AccentPolicy.GradientColor tiene efecto cuando juegas con AccentPolicy.AccentFlags , encontré estos valores:

• 2 : llena la ventana con AccentPolicy.GradientColor - lo que necesitas
• 4 - hace que el área a la derecha e inferior de la ventana esté borrosa (extraño)
• 6 - combinación de lo anterior: llena la pantalla completa con AccentPolicy.GradientColor y difumina el área como 4

Para establecer la propiedad AccentPolicy.GradientColor , necesitará los colores de los sistemas ActiveCaption e InactiveCaption. GetImmersiveColor* la sugerencia de Rafael de usar la familia de funciones GetImmersiveColor* . También hay una question para Vista / 7.

Nota: Intenté dibujar con GDI + y vi que FillRectangle() funciona incorrectamente con Glass cuando brush.alpha==0xFF ( soluciones alternativas aquí ). Los rectángulos internos tienen brush.alpha==0xFE en ambas capturas de pantalla debido a este error.

Capturas de pantalla Nota: GradientColor==0x80804000 , no tiene que ser premultiplicado, solo una coincidencia.