ドキュメントに記載されていない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;
これらの最初の2つは this github Gist にあることに注意してください。
3番目は正常に機能します。これによりガラスが可能になります。他の2つのうち、
これが近づいてきており、ボリュームコントロールアプレットのようないくつかのポップアップウィンドウが使用しているようです。
値を一緒に論理和演算することはできません。GradientColorフィールドの値は、ゼロ以外でなければならないことを除いて、効果がありません。
ガラス対応ウィンドウに直接描画すると、非常に奇妙なブレンドになります。ここでは、クライアント領域を赤(ABGR形式の0x000000FF)で塗りつぶしています。
また、0以外のアルファ(0xAA0000FFなど)の場合、色はまったくありません。
[スタート]メニューや通知領域の外観と一致しません。
それらのウィンドウはそれをどのように行うのですか?
GDIフォームはアルファチャネルをサポートしていないため(適切でない可能性のあるアルファレイヤードウィンドウを使用しない限り)、コンポーネントがサポートしていない限り、通常、黒色は透明色として使用されます。アルファチャネル。
tl; drTTransparentCanvas クラス、.Rectangle(0,0,Width+1,Height+1,222)
、色を使用するだけ DwmGetColorizationColor を使用して取得し、暗い色で blend できます。
以下は、代わりにTImageコンポーネントを使用します。
TImageとTImage32(Graphics32)を使用して、アルファチャネルとの違いを示します。ボーダーはカラー化を受け入れないため、これはボーダーレスフォームです。
ご覧のとおり、左側は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;
これがフォームがスタートメニューのように見える方法です。
ここで、アクセントカラーを取得するには、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%ブレンドした結果です:
たとえば、アクセントカラーがいつ変更されたかを検出し、アプリの色も自動的に更新するなど、他にも追加したいものがあります。次に例を示します。
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が回避されます。色付けが含まれていることに注意してください。手動でペイントする必要はありません。
_AccentPolicy.GradientColor
_を使用すると、_AccentPolicy.AccentFlags
_が有効になります。これらの値が見つかりました。
2
_-ウィンドウを_AccentPolicy.GradientColor
_で埋めます-必要なもの 4
_-ウィンドウの右と下の領域をぼかします(奇妙)6
_-上記の組み合わせ:画面全体を_AccentPolicy.GradientColor
_で塗りつぶし、_4
_のような領域をぼかします _AccentPolicy.GradientColor
_プロパティを設定するには、ActiveCaptionおよびInactiveCaptionシステムカラーが必要です。 私は_ (更新を参照)。また、Vista/7には 質問 があります。GetImmersiveColor*
_ファミリーの関数を使用するようにラファエルの提案を試みます
注: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);
_
フォームに透明な色のコンポーネントを追加するだけです。 TPanel(Delphi)のような自己記述型コンポーネントがあります。
ここでアルファ= 40%: