web-dev-qa-db-ja.com

Windows 10でガラスブレンドカラーをどのように設定しますか?

ドキュメントに記載されていないSetWindowCompositionAttribute AP​​I をWindows 10で使用すると、ウィンドウのガラスを有効にすることができます。このスクリーンショットにあるように、ガラスは白または透明です。

enter image description here

ただし、Windows 10のスタートメニューと通知センターはどちらもガラスを使用しており、どちらも次のようにアクセントカラーと調和しています。

enter image description here

どうやってやるの?

調査

次の例のアクセントカラーは薄紫色です。設定アプリのスクリーンショットを次に示します。

enter image description here

このコード例で定義されている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;

これらの最初の2つは this github Gist にあることに注意してください。

3番目は正常に機能します。これによりガラスが可能になります。他の2つのうち、

  • ACCENT_ENABLE_GRADIENTを指定すると、背後にあるものに関係なく、ウィンドウは完全に灰色になります。透明度やガラス効果はありませんが、描画されているウィンドウの色はアプリではなくDWMによって描画されています。

enter image description here

  • ACCENT_ENABLE_TRANSPARENTGRADIENTは、ウィンドウの背後にあるものに関係なく、完全にアクセントカラーでペイントされるウィンドウを生成します。透明度やガラス効果はありませんが、描画されているウィンドウの色はアプリではなくDWMによって描画されています。

enter image description here

これが近づいてきており、ボリュームコントロールアプレットのようないくつかのポップアップウィンドウが使用しているようです。

値を一緒に論理和演算することはできません。GradientColorフィールドの値は、ゼロ以外でなければならないことを除いて、効果がありません。

ガラス対応ウィンドウに直接描画すると、非常に奇妙なブレンドになります。ここでは、クライアント領域を赤(ABGR形式の0x000000FF)で塗りつぶしています。

enter image description here

また、0以外のアルファ(0xAA0000FFなど)の場合、色はまったくありません。

enter image description here

[スタート]メニューや通知領域の外観と一致しません。

それらのウィンドウはそれをどのように行うのですか?

23
David

GDIフォームはアルファチャネルをサポートしていないため(適切でない可能性のあるアルファレイヤードウィンドウを使用しない限り)、コンポーネントがサポートしていない限り、通常、黒色は透明色として使用されます。アルファチャネル。

tl; drTTransparentCanvas クラス、.Rectangle(0,0,Width+1,Height+1,222)、色を使用するだけ DwmGetColorizationColor を使用して取得し、暗い色で blend できます。

以下は、代わりにTImageコンポーネントを使用します。

TImageとTImage32(Graphics32)を使用して、アルファチャネルとの違いを示します。ボーダーはカラー化を受け入れないため、これはボーダーレスフォームです。

enter image description here

ご覧のとおり、左側はTImage1を使用しており、Aero Glassの影響を受けています。右側はTGraphics32を使用しており、不透明色(半透明ではない)でオーバーレイできます。

ここで、次のコードで作成できる半透明のPNGを持つTImage1を使用します。

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;

enter image description here

これがフォームがスタートメニューのように見える方法です。

ここで、アクセントカラーを取得するには、DwmAPI.pasで既に定義されている DwmGetColorizationColor を使用します。

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とアクセントカラーを50%ブレンドした結果です: enter image description here

たとえば、アクセントカラーがいつ変更されたかを検出し、アプリの色も自動的に更新するなど、他にも追加したいものがあります。次に例を示します。

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のスタートメニュー設定との一貫性を維持するために、レジストリを読み取って、タスクバー/スタートメニューが半透明(有効)であり、スタートメニューがアクセントカラーまたは黒の背景のみを使用できるようになっているかどうかを確認できます。教えてくれます:

'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.

これが ソースコードとデモバイナリ です。

もっと良い方法があるといいのですが、あれば教えてください。

C#およびWPFではBTWの方が簡単ですが、これらのアプリはコールドスタートが非常に遅いです。

[ボーナスアップデート]または、Windows 10 April 2018 Update以降(Fall Creators Updateで機能する可能性があります)では、代わりにアクリルぼかしを使用できます。次のように使用します。

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

ただし、これはWM_NCCALCSIZEが実行される場合は機能しない可能性があります。つまり、bsNoneボーダースタイルでのみ機能するか、WM_NCALCSIZEが回避されます。色付けが含まれていることに注意してください。手動でペイントする必要はありません。

15
vhanla

_AccentPolicy.GradientColor_を使用すると、_AccentPolicy.AccentFlags_が有効になります。これらの値が見つかりました。

  • _2_-ウィンドウを_AccentPolicy.GradientColor_で埋めます-必要なもの AccentFlags=2
  • _4_-ウィンドウの右と下の領域をぼかします(奇妙)
  • _6_-上記の組み合わせ:画面全体を_AccentPolicy.GradientColor_で塗りつぶし、_4_のような領域をぼかします AccentFlags=6

_AccentPolicy.GradientColor_プロパティを設定するには、ActiveCaptionおよびInactiveCaptionシステムカラーが必要です。 私は_GetImmersiveColor*_ファミリーの関数を使用するようにラファエルの提案を試みます (更新を参照)。また、Vista/7には 質問 があります。

注:GDI +で描画してみましたが、_brush.alpha==0xFF_( 回避策はこちら )の場合、FillRectangle()がGlassで正しく機能しないことを確認しました。このバグにより、内側の長方形のスクリーンショットには_brush.alpha==0xFE_が表示されます。

スクリーンショットのメモ:_GradientColor==0x80804000_、事前に乗算する必要はありません。偶然です。

更新:アクセントカラーを取得するには、C++/WinRTを使用できます。これは文書化されているため、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);
_
9
Mykola Bogdiuk

フォームに透明な色のコンポーネントを追加するだけです。 TPanel(Delphi)のような自己記述型コンポーネントがあります。

ここでアルファ= 40%:

Here Alpha = 40%:

4
Iban