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

sans-papiers SetWindowCompositionAttribute API sur Windows 10, il est possible d'activer le verre d'une fenêtre. Le verre est blanc ou clair, comme le montre cette capture d'écran:

enter image description here

cependant, le menu de démarrage de Windows 10 et le centre de notification, qui tous les deux utilise également le verre, les deux se fondent avec la couleur de l'accent, comme ainsi:

enter image description here

Comment fait-il il?

Enquêtes

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

enter image description here

structure de la Politique D'Accentdéfinie dans cet exemple de code a l'état d'accent, les drapeaux et les champs de couleurs de gradient:

  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 ont été trouvés ce GitHub gist.

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

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

enter image description here

  • ACCENT_ENABLE_TRANSPARENTGRADIENT results in une fenêtre qui est peinte entièrement à la couleur d'accentuation, indépendamment de ce qui est derrière elle. Il n'y a pas d'effet de transparence ou de verre, mais la couleur de la fenêtre est dessinée par le DWM, pas par l'app.

enter image description here

donc cela se rapproche, et il semble être ce que certaines fenêtres popup comme l'applet de contrôle de volume utilisent.

les valeurs ne peuvent pas être ou-ed ensemble, et la valeur du champ GradientColor n'a aucun effet, sauf qu'il doit être non nul.

dessiner directement sur une fenêtre activée par le verre résulte en un mélange très étrange. Ici, il remplit la zone client avec du rouge (0x000000FF au format ABGR):

enter image description here

et non-zero alpha, par exemple, 0xAA0000FF, les résultats dans les pas de couleur du tout:

enter image description here

ne correspond pas à L'apparence du menu Démarrer ou de la notification zone.

comment font ces fenêtres?

16
demandé sur David M 2015-09-22 21:24:52

3 réponses

étant donné que les formes GDI sur Delphi ne prennent pas en charge les canaux alpha (à moins d'utiliser des fenêtres en couches alpha, qui pourraient ne pas convenir), la couleur noire sera généralement considérée comme la couleur transparente, à moins que le composant ne supporte les canaux alpha.

tl;dr il suffit d'utiliser votre TTransparentCanvas classe .Rectangle(0,0,Width+1,Height+1,222), en utilisant la couleur obtenue avec DwmGetColorizationColor que vous pourriez mélange avec une obscurité couleur.

ce qui suit utilisera la composante de temps à la place.

je vais utiliser un TImage et un TImage32 (Graphics32) pour montrer la différence avec les canaux alpha. C'est une forme sans frontières, parce que les frontières n'accepteront pas notre colorisation.

enter image description here

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

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 avons besoin d'ajouter un autre composant de chronométrage à notre formulaire et de 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;

enter image description here

et c'est ainsi que notre formulaire ressemblera au Menu Démarrer.

maintenant, pour obtenir la couleur de l'accent utiliser 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 foncée comme le montre le Menu Démarrer.

nous avons Donc besoin de 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 c'est le résultat du mélange clBlack avec la couleur Accent par 50%: enter image description here

il y a d'autres choses que vous pourriez vouloir ajouter, comme par exemple la détection quand le l'accent change de couleur et met automatiquement à jour la couleur de notre application, par exemple:

procedure WndProc(var Message: TMessage);override;
...
procedure TForm1.WndProc(var Message: TMessage);
const
  WM_DWMCOLORIZATIONCOLORCHANGED = 20;
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 de menu de démarrage de Windows 10, vous pouvez lire le Registre pour savoir si le Taskbar/StartMenu est translucide (activé) et le menu de démarrage est activé pour utiliser la couleur de l'accent ou juste un fond noir, pour le faire, cette touche 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 Timagee1, Timagee2, pour la colorisation, les autres ne sont pas facultatif.

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 = ;
  DrawTopBorder = ;
  DrawRightBorder = ;
  DrawBottomBorder = 0;
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 = 20;
begin
  if Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED then
  begin
      UpdateColorization;
  end;
  inherited WndProc(Message);

end;

initialization
  SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute');
end.

Ici code source et démo binaire j'espère que ça aide.

j'espère qu'il ya une meilleure façon, et s'il en est, s'il vous plaît laissez-nous savoir.

BTW sur C# et WPF, il est plus facile, mais ces applications sont très lents sur démarrage à froid.

[Bonus De Mise À Jour] Alternativement sur Windows 10 avril 2018 Mise à jour ou plus récent (pourrait travailler sur les créateurs D'Automne mise à jour), vous pouvez utiliser acrylique flou derrière à 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_NCALCSIZE est exécuté, i.e. ne fonctionnera que sur bsNone style de bordure ou WM_NCALCSIZE évité. Notez que la colorisation est inclus, pas besoin de peindre manuellement.

11
répondu vhanla 2018-05-12 01:56:18

AccentPolicy.GradientColor a de l'effet quand vous jouez avec AccentPolicy.AccentFlags, j'ai trouvé ces valeurs:

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

AccentPolicy.GradientColor propriété, vous aurez besoin des couleurs du système D'activation et D'InactiveCaption. Je voudrais essayer de Rafael suggestion d'utiliser GetImmersiveColor* famille de fonctions. Il y a aussi un question pour Vista / 7.

Note: j'ai essayé de dessiner avec GDI+ et j'ai vu que FillRectangle() fonctionne mal avec le verre quand brush.alpha==0xFF (solutions de contournement ici). Les rectangles intérieurs ont brush.alpha==0xFE sur les deux screenshots à cause de ce bug.

Captures d'écran remarque: GradientColor==0x80804000, il ne doit pas être prémultiplié, juste une coïncidence.

7
répondu Mykola Bogdiuk 2017-05-23 12:09:06

il suffit d'ajouter le composant transparent coloré à la forme. J'ai un composant selfwriten comme Tcpanel (sur Delphi).

Ici Alpha = 40%:

Here Alpha = 40%:

4
répondu Iban 2015-10-09 04:04:32