results

results

关注
发信
关注(28)粉丝(399)

如何在 Windows 10 上设置玻璃混合颜色?

本文介绍了如何在 Windows 10 上设置玻璃混合颜色?的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

使用

但是，Windows 10 的开始菜单和通知中心也都使用玻璃材质，它们都与强调色融为一体，如下所示:

它是如何做到的?

调查

以下示例中的强调色为浅紫色 - 这是设置"应用中的屏幕截图:

  • ACCENT_ENABLE_TRANSPARENTGRADIENT 会生成一个完全用强调色绘制的窗口，无论其后面是什么.没有透明度或玻璃效果，但正在绘制的窗口颜色是由 DWM 绘制的，而不是由应用绘制的.

所以这已经很接近了，它似乎是一些像音量控制小程序这样的弹出窗口所使用的.

这些值不能一起使用或运算，并且 GradientColor 字段的值除了必须非零之外没有任何影响.

直接在启用玻璃的窗口上绘图会导致非常奇怪的混合.这里用红色填充客户区(ABGR 格式的 0x000000FF):

和任何非零 alpha，例如 0xAA0000FF，都不会产生任何颜色:

与开始"菜单或通知区域的外观都不匹配.

那些窗户是怎么做的?

解决方案

由于 Delphi 上的 GDI 窗体不支持 alpha 通道(除非使用 alpha 分层窗口，这可能不合适)，通常黑色将被视为透明的，除非组件支持 alpha 通道.

tl;dr 只需使用您的

如您所见，左侧使用的是 TImage1 并受 Aero Glass 影响，右侧使用的是 TGraphics32，它允许使用不透明颜色(无半透明)进行叠加.

现在，我们将使用带有半透明 PNG 的 TImage1，我们可以使用以下代码创建它:

过程 SetAlphaColorPicture(const Col: TColor;const Alpha:整数；图片:TPicture；const _width:整数；const _height:整数);无功png: TPngImage;x,y:整数；sl: pByteArray;开始png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);尝试png.Canvas.Brush.Color := Col;png.Canvas.FillRect(Rect(0,0,_width,_height));对于 y := 0 到 png.Height - 1 做开始sl := png.AlphaScanline[y];FillChar(sl^, png.Width, Alpha);结尾;图片.赋值(png);最后png.免费;结尾;结尾;

我们需要将另一个 TImage 组件添加到我们的表单中并将其发送回来，以便其他组件不会在它之下.

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

这就是我们的表单看起来像开始菜单的样子.

现在，要获得强调色，请使用

您可能还想添加其他内容，例如检测强调色何时发生变化并自动更新我们的应用程序颜色，例如:

procedure WndProc(var Message: TMessage);override;...过程 TForm1.WndProc(var Message: TMessage);常量WM_DWMCOLORIZATIONCOLORCHANGED = $0320;开始如果 Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED 那么开始//这里我们用新颜色更新 TImage结尾;继承 WndProc(Message);结尾;

为了保持与 Windows 10 开始菜单设置的一致性，您可以阅读注册表以了解 Taskbar/StartMenu 是否为半透明(已启用)以及是否已启用开始菜单以使用强调色或仅使用黑色背景，这样做所以这个键会告诉我们:

'SOFTWAREMicrosoftWindowsCurrentVersionThemesPersonalize'ColorPrevalence = 1 或 0(启用/禁用)启用透明度 = 1 或 0

这是完整代码，需要TImage1、TImage2进行着色，其他不可选.

unit Unit1;界面用途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、注册表；类型TForm1 = 类(TForm)Button1:TButton；Image1:TImage；Image3:TImage；Image321:TImage32；程序 FormCreate(Sender: TObject);程序 FormMouseDown(Sender: TObject; Button: TMouseButton;Shift:TShiftState；X，Y:整数)；过程 Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift:TShiftState；X，Y:整数)；过程 Button1Click(Sender: TObject);私人的{ 私人声明}功能 TaskbarAccented:boolean;功能 TaskbarTranslucent:boolean;程序启用模糊；函数 GetAccentColor:TColor;函数 BlendColors(Col1, Col2: TColor; A: Byte): TColor;过程 WndProc(var Message: TMessage);override;程序更新着色；上市{ 公开声明 }结尾;AccentPolicy = 打包记录AccentState:整数；AccentFlags:整数；渐变颜色:整数；动画 ID:整数；结尾;TWinCompAttrData = 打包记录属性:THandle；pData:指针；数据大小:ULONG；结尾;无功Form1:TForm1；无功SetWindowCompositionAttribute: function (Wnd: HWND; const AttrData: TWinCompAttrData): BOOL;stdcall = 无；执行{$R *.dfm}过程 SetAlphaColorPicture(const Col: TColor;const Alpha:整数；图片:TPicture；const _width:整数；const _height:整数);无功png: TPngImage;x,y:整数；sl: pByteArray;开始png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, _width, _height);尝试png.Canvas.Brush.Color := Col;png.Canvas.FillRect(Rect(0,0,_width,_height));对于 y := 0 到 png.Height - 1 做开始sl := png.AlphaScanline[y];FillChar(sl^, png.Width, Alpha);结尾;图片.赋值(png);最后png.免费;结尾;结尾;过程 TForm1.Button1Click(Sender: TObject);开始关闭;结尾;程序 TForm1.EnableBlur;常量WCA_ACCENT_POLICY = 19;ACCENT_ENABLE_BLURBEHIND = 3;DrawLeftBorder = $20;DrawTopBorder = 40 美元；DrawRightBorder = $80;DrawBottomBorder = 100 美元；无功dwm10:THandle；数据:TWinCompAttrData；口音:AccentPolicy；开始dwm10 := LoadLibrary('user32.dll');尝试@SetWindowCompositionAttribute := GetProcAddress(dwm10, 'SetWindowCompositionAttribute');如果@SetWindowCompositionAttribute <>零然后开始Accent.AccentState := ACCENT_ENABLE_BLURBEHIND ;AccentFlags := DrawLeftBorder 或 DrawTopBorder 或 DrawRightBorder 或 DrawBottomBorder;data.Attribute := WCA_ACCENT_POLICY;data.dataSize := SizeOf(accent);数据.pData := @accent;SetWindowCompositionAttribute(Handle, data);结尾别的开始ShowMessage('未找到 Windows 10 模糊 API');结尾;最后自由图书馆(dwm10)；结尾;结尾;程序 TForm1.FormCreate(Sender: TObject);无功BlendFunc: TBlendFunction;bmp: TBitmap;开始双缓冲:=真；颜色:= clBlack；边框样式:= bsNone;如果 TaskbarTranslucent 那么启用模糊；更新着色；(*BlendFunc.BlendOp := AC_SRC_OVER;BlendFunc.BlendFlags := 0;BlendFunc.SourceConstantAlpha := 96;BlendFunc.AlphaFormat := AC_SRC_ALPHA;bmp := TBitmap.Create;尝试bmp.SetSize(宽度，高度)；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);最后bmp.免费;结尾;*)结尾;过程 TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift:TShiftState；X，Y:整数)；开始释放捕捉；执行(WM_SYSCOMMAND，$F012，0)；结尾;过程 TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;Shift:TShiftState；X，Y:整数)；开始释放捕捉；执行(WM_SYSCOMMAND，$F012，0)；结尾;函数 TForm1.TaskbarAccented:布尔值；无功注册:TRegistry；开始结果:=假；reg := TRegistry.Create;尝试reg.RootKey := HKEY_CURRENT_USER;reg.OpenKeyReadOnly('SOFTWAREMicrosoftWindowsCurrentVersionThemesPersonalize');尝试如果 reg.ReadInteger('ColorPrevalence') = 1 那么结果:=真；除了结果:=假；结尾;reg.CloseKey;最后注册免费；结尾;结尾;函数 TForm1.TaskbarTranslucent: boolean;无功注册:TRegistry；开始结果:=假；reg := TRegistry.Create;尝试reg.RootKey := HKEY_CURRENT_USER;reg.OpenKeyReadOnly('SOFTWAREMicrosoftWindowsCurrentVersionThemesPersonalize');尝试如果 reg.ReadInteger('EnableTransparency') = 1 那么结果:=真；除了结果:=假；结尾;reg.CloseKey;最后注册免费；结尾;结尾;程序 TForm1.UpdateColorization;开始如果 TaskbarTranslucent 那么开始如果 TaskbarAccented 那么SetAlphaColorPicture(BlendColors(GetAccentColor, clBlack, 50), 222, Image1.Picture, 10, 10)别的SetAlphaColorPicture(clblack, 222, Image1.Picture, 10,10 );Image1.Align := alClient;Image1.Stretch := True;Image1.Visible := True;结尾别的Image1.Visible := False;结尾;函数 TForm1.GetAccentColor:TColor;无功col:红衣主教；不透明:longbool；新颜色:TColor；a,r,g,b:字节；开始DwmGetColorizationColor(col, opaque);a := 字节(col shr 24);r := 字节(col shr 16);g := 字节(col shr 8);b := 字节(列)；新颜色:= RGB(轮(r*(a/255)+255-a)，轮(g*(a/255)+255-a)，轮(b*(a/255)+255-a));结果:=新颜色；结尾;//感谢 Roy M Klever http://rmklever.com/?p=116函数 TForm1.BlendColors(Col1, Col2: TColor; A: Byte): TColor;无功c1,c2: LongInt;r,g,b,v1,v2:字节；开始A := 回合(2.55 * A);c1 := ColorToRGB(Col1);c2 := ColorToRGB(Col2);v1 := 字节(c1);v2 := 字节(c2);r := A * (v1 - v2) shr 8 + v2；v1 := 字节(c1 shr 8);v2 := 字节(c2 shr 8);g := A * (v1 - v2) shr 8 + v2；v1 := 字节(c1 shr 16);v2 := 字节(c2 shr 16);b := A * (v1 - v2) shr 8 + v2；结果:= (b shl 16) + (g shl 8) + r；结尾;过程 TForm1.WndProc(var Message: TMessage);//常量//WM_DWMCOLORIZATIONCOLORCHANGED = $0320;开始如果 Message.Msg = WM_DWMCOLORIZATIONCOLORCHANGED 那么开始更新着色；结尾;继承 WndProc(Message);结尾;初始化SetWindowCompositionAttribute := GetProcAddress(GetModuleHandle(user32), 'SetWindowCompositionAttribute');结尾.

这是源代码和演示二进制文件希望有帮助.

我希望有更好的方法，如果有，请告诉我们.

顺便说一句，在 C# 和 WPF 上它更容易，但这些应用程序在冷启动时非常慢.

[奖励更新]或者，在 Windows 10 April 2018 Update 或更新版本(可能适用于 Fall Creators Update)上，您可以使用 Acrylic blur behind，它可以如下使用:

const ACCENT_ENABLE_ACRYLICBLURBEHIND = 4;...口音.AccentState := ACCENT_ENABLE_ACRYLICBLURBEHIND;//$AABBGGRRAccent.GradientColor := (opacity SHL 24) 或 (clRed);

但如果执行 WM_NCCALCSIZE，这可能不起作用，即仅适用于 bsNone 边框样式或避免 WM_NCALCSIZE.请注意，包括着色，无需手动绘制.

Using the undocumented SetWindowCompositionAttribute API on Windows 10, it's possible to enable glass for a window. The glass is white or clear, as seen in this screenshot:

However, the Windows 10 Start menu and the notification center, which both also uses glass, both blend with the accent colour, like so:

How does it do it?

Investigations

The accent colour in the following examples is a light purple - here's a screenshot from the Settings app:

The AccentPolicy structure defined in this example code has accent state, flags and gradient color fields:

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

and the state can have any of these values:

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

Note that the first two of these were found on this github gist.

The third works fine - that enables glass. Of the other two,

  • ACCENT_ENABLE_GRADIENT results in a window that is completely gray, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.
  • ACCENT_ENABLE_TRANSPARENTGRADIENT results in a window that is painted completely with the accent colour, regardless of what is behind it. There is no transparency or glass effect, but the window colour being drawn is being drawn by the DWM, not by the app.

So this is getting close, and it seems to be what some of the popup windows like the volume control applet use.

The values can't be or-ed together, and the value of the GradientColor field has no effect except that it must be non-zero.

Drawing directly on a glass-enabled window results in very odd blending. Here it's filling the client area with red (0x000000FF in ABGR format):

and any non-zero alpha, eg 0xAA0000FF, results in no colour at all:

Neither match the look of the Start menu or notification area.

How do those windows do it?

解决方案

Since GDI forms on Delphi don't support alpha channels (unless using alpha layered windows, which might not be suitable), commonly the black color will be taken as the transparent one, unless the component supports alpha channels.

tl;dr Just use your TTransparentCanvas class, .Rectangle(0,0,Width+1,Height+1,222), using the color obtained with DwmGetColorizationColor that you could blend with a dark color.

The following will use TImage component instead.

I'm going to use a TImage and TImage32 (Graphics32) to show the difference with alpha channels. This is a borderless form, because borders won't accept our colorization.

As you can see, the left one is using TImage1 and is affected by Aero Glass, and the right one is using TGraphics32, which allows to overlay with opaque colors (no translucent).

Now, we will be using a TImage1 with a translucent PNG that we can create with the following code:

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;

We need to add another TImage component to our form and send it back so other components won't be below it.

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

And that's is how our form will look like the Start Menu.

Now, to get the accent color use DwmGetColorizationColor, which is already defined in 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;

However, that color won't be dark enough as shown by the Start Menu.

So we need to blend the accent color with a dark color:

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

And this is the result blending clBlack with the Accent color by 50%:

There are other things that you might want to add, like for example detecting when the accent color changes and automatically update our app color too, for example:

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;

To maintain consistency with Windows 10 start menu settings, you can read the registry to find out if the Taskbar/StartMenu is translucent (enabled) and the start menu is enabled to use the accent color or just a black background, to do so this keys will tell us:

'SOFTWAREMicrosoftWindowsCurrentVersionThemesPersonalize'
ColorPrevalence = 1 or 0 (enabled / disabled)
EnableTransparency = 1 or 0

This is the full code, you need TImage1, TImage2, for the colorization, the other ones are not optional.

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('SOFTWAREMicrosoftWindowsCurrentVersionThemesPersonalize');
    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('SOFTWAREMicrosoftWindowsCurrentVersionThemesPersonalize');
    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.

Here is the source code and demo binary hope it helps.

I hope there is a better way, and if there is, please let us know.

BTW on C# and WPF it is easier, but those apps are very slow on cold start.

[Bonus Update]Alternatively on Windows 10 April 2018 Update or newer (might work on Fall Creators Update), you can use Acrylic blur behind instead, it can be used as follows:

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

But this might not work if WM_NCCALCSIZE is executed, i.e. will only work on bsNone border style or WM_NCALCSIZE avoided. Notice that colorizing is included, no need to paint manually.

这篇关于如何在 Windows 10 上设置玻璃混合颜色?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！

07-24 03:11
Powered by LMLPHP ©2024 results 0.052782