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.