Comment définissez-vous la couleur du mélange de verre sur Windows 10?

Question

En utilisant API SetWindowCompositionAttribute non documentée sur Windows 10, il est possible d'activer le verre pour une fenêtre. Le verre est blanc ou transparent, comme le montre cette capture d'écran:

Cependant, le menu Démarrer de Windows 10 et le centre de notification, qui utilisent tous deux également du verre, se fondent tous deux dans la couleur d'accent, comme suit:

Comment ça marche?

Enquêtes

La couleur d'accentuation dans les exemples suivants est un violet clair - voici une capture d'écran de l'application Paramètres:

La structure AccentPolicy définie dans cet exemple de code a un état d'accentuation, des drapeaux et des champs de couleur dégradés:

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

et l'état peut avoir l'une de ces valeurs:

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

Notez que les deux premiers d'entre eux ont été trouvés sur ce github Gist .

Le troisième fonctionne bien - qui permet le verre. Des deux autres,

• ACCENT_ENABLE_GRADIENT donne une fenêtre complètement grise, indépendamment de ce qui se trouve derrière. Il n'y a pas de transparence ou d'effet de verre, mais la couleur de la fenêtre dessinée est dessinée par le DWM, pas par l'application.

• ACCENT_ENABLE_TRANSPARENTGRADIENT donne une fenêtre entièrement peinte avec la couleur d'accent, indépendamment de ce qui se trouve derrière. Il n'y a pas de transparence ou d'effet de verre, mais la couleur de la fenêtre dessinée est dessinée par le DWM, pas par l'application.

Donc, cela se rapproche, et il semble que ce que certaines des fenêtres contextuelles comme l'applet de contrôle du volume utilisent.

Les valeurs ne peuvent pas être or-ed ensemble, et la valeur du champ GradientColor n'a aucun effet, sauf qu'il doit être différent de zéro.

Dessiner directement sur une fenêtre vitrée entraîne un mélange très étrange. Ici, il remplit la zone client de rouge (0x000000FF au format ABGR):

et tout alpha non nul, par exemple 0xAA0000FF, ne produit aucune couleur:

Ni correspondre à l'apparence du menu Démarrer ou de la zone de notification.

Comment font ces fenêtres?

Answer 1

Étant donné que GDI sur Delphi ne prennent pas en charge les canaux alpha (sauf si vous utilisez des fenêtres en couches alpha, qui pourraient ne pas convenir), la couleur noire sera généralement considérée comme transparente, sauf si le composant prend en charge canaux alpha.

tl; dr Utilisez simplement votre classe TTransparentCanvas , .Rectangle(0,0,Width+1,Height+1,222), en utilisant la couleur obtenue avec DwmGetColorizationColor que vous pourriez mélanger avec une couleur sombre.

Les éléments suivants utiliseront à la place le composant TImage.

Je vais utiliser un TImage et TImage32 (Graphics32) pour montrer la différence avec les canaux alpha. Il s'agit d'une forme sans bordure, car les bordures n'accepteront pas notre colorisation.

Comme vous pouvez le voir, celui de gauche utilise TImage1 et est affecté par Aero Glass, et celui de droite utilise TGraphics32, ce qui permet de superposer avec des couleurs opaques (pas translucides).

Maintenant, nous allons utiliser un TImage1 avec un PNG translucide que nous pouvons créer avec le code suivant:

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;

Nous devons ajouter un autre composant TImage à notre formulaire et le renvoyer pour que les autres composants ne soient pas en dessous.

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

Et c'est ainsi que notre formulaire ressemblera au menu Démarrer.

Maintenant, pour obtenir la couleur d'accent, utilisez DwmGetColorizationColor , qui est déjà défini dans 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;

Cependant, cette couleur ne sera pas assez sombre comme le montre le menu Démarrer.

Nous devons donc mélanger la couleur d'accent avec une couleur sombre:

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

Et voici le résultat en mélangeant clBlack avec la couleur Accent de 50%:

Il y a d'autres choses que vous voudrez peut-être ajouter, comme par exemple détecter quand la couleur d'accent change et mettre à jour automatiquement la couleur de notre application aussi, par exemple:

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;   

Pour maintenir la cohérence avec les paramètres du menu de démarrage de Windows 10, vous pouvez lire le registre pour savoir si la barre des tâches/menu de démarrage est translucide (activé) et le menu de démarrage est activé pour utiliser la couleur d'accentuation ou simplement un fond noir, pour ce faire, ces touches nous dira:

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

C'est le code complet, vous avez besoin de TImage1, TImage2, pour la colorisation, les autres ne sont pas optionnels.

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.

Voici le code source et binaire de démonstration j'espère que cela aide.

J'espère qu'il y a une meilleure façon, et si c'est le cas, faites-le nous savoir.

BTW sur C # et WPF c'est plus facile, mais ces applications sont très lentes au démarrage à froid.

[ Bonus Update ] Alternativement sur Windows 10 April 2018 Update ou plus récent (peut fonctionner sur Fall Creators Update), vous pouvez utiliser le flou acrylique à la place, il peut être utilisé comme suit:

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

Mais cela pourrait ne pas fonctionner si WM_NCCALCSIZE est exécuté, c'est-à-dire ne fonctionnera que sur le style de bordure bsNone ou si WM_NCALCSIZE sera évité. Notez que la colorisation est incluse, pas besoin de peindre manuellement.

Answer 2

AccentPolicy.GradientColor A un effet lorsque vous jouez avec AccentPolicy.AccentFlags, J'ai trouvé ces valeurs:

• 2 - remplit la fenêtre avec AccentPolicy.GradientColor - ce dont vous avez besoin
• 4 - rend la zone à droite et en bas de la fenêtre floue (bizarre)
• 6 - combinaison de ce qui précède: remplit tout l'écran avec AccentPolicy.GradientColor Et brouille la zone comme 4

Pour définir la propriété AccentPolicy.GradientColor, Vous aurez besoin des couleurs système ActiveCaption et InactiveCaption. J'essaierais la suggestion de Rafael d'utiliser la famille de fonctions GetImmersiveColor* (voir mise à jour). Il y a aussi une question pour Vista/7.

Remarque: J'ai essayé de dessiner avec GDI + et j'ai vu que FillRectangle() ne fonctionnait pas correctement avec Glass lorsque brush.alpha==0xFF ( solutions de contournement ici ). Les rectangles intérieurs ont brush.alpha==0xFE Sur les deux captures d'écran à cause de ce bogue.

Remarque sur les captures d'écran: GradientColor==0x80804000, Il n'a pas besoin d'être prémultiplié, juste une coïncidence.

Mise à jour: Pour obtenir une couleur d'accentuation, vous pouvez utiliser C++/WinRT - c'est une approche documentée et donc préférée pour 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);

Answer 3

Ajoutez simplement un composant coloré transparent au formulaire. J'ai un composant auto-écrit comme TPanel (sur Delphi).

Ici Alpha = 40%: