Как вы устанавливаете цвет стеклянной смеси на 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, не приводит к отсутствию цвета:

Совместимо с внешним видом меню "Пуск" или "Область уведомлений".

Как эти окна делают это?

Ответ 1

Так как формы 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.

Вот исходный код и демонстрационный бинарный файл, надеюсь, что это поможет.

Я надеюсь, что есть лучший способ, и если есть, сообщите нам.

Кстати на С# и WPF это проще, но эти приложения очень медленны при холодном запуске.

Ответ 2

AccentPolicy.GradientColor имеет эффект, когда вы играете с AccentPolicy.AccentFlags, я нашел эти значения:

2 - заполняет окно с помощью AccentPolicy.GradientColor - что вам нужно
4 - делает область справа и внизу окна размытой (странной).
6 - комбинация выше: заполняет весь экран с помощью AccentPolicy.GradientColor и размывает область, например 4

Чтобы установить свойство AccentPolicy.GradientColor, вам понадобятся цвета системы ActiveCaption и InactiveCaption. Я бы попробовал предложение Рафаэля использовать семейство функций GetImmersiveColor*. Также есть question для Vista/7.

Примечание. Я попробовал рисовать с помощью GDI + и увидел, что FillRectangle() работает неправильно со стеклом, когда brush.alpha==0xFF (обходные пути здесь). Из-за этой ошибки внутренние прямоугольники имеют brush.alpha==0xFE на обоих снимках экрана.

Заметки к скриншотам: GradientColor==0x80804000, это не должно быть предварительно умножено, просто совпадение.

Ответ 3

Просто добавьте прозрачный цветной компонент в форму. У меня есть самостоятельный компонент, такой как TPanel (на Delphi).

Здесь Alpha = 40%: