VCLスタイルが有効になっているときに透明なフォームを作成する方法は?
-
25-10-2019 - |
質問
次のコードを使用してフォームを透明にしますが、アプリケーションにVCLスタイルが有効になっている場合、フォームは透明ではなくVCLスタイルの背景色のペイントです。
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
type
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure CreateParams(var Params:TCreateParams); override;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
//Params.ExStyle := Params.ExStyle or WS_EX_LAYERED;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Brush.Style:=bsClear;
BorderStyle:=bsNone;
//SetLayeredWindowAttributes(Handle, 0, 230, $00000002);
end;
参考までに、VCLスタイルが設定されている場合、コードは正常に機能します Windows
.
この問題を回避するためにフォームを透明にする別の方法がありますか?
解決
私にはバグのようです。 VCLスタイルの使用 スタイルフック これらの操作に関連するペイントメソッドとWindowsメッセージを傍受するには、この場合、 PaintBackground
の方法 TFormStyleHook
にあります Vcl.Forms
, 、ここから新しいスタイルのフッククラスを作成します(から降ります tformstylehook)、オーバーライドします PaintBackground
メソッド、コードを修正し、最終的に使用する前にregisterStylehookメソッドを呼び出して新しいものを登録します スタイルフック. 。この記事を確認してください Fixing a VCL Style bug in the TPageControl and TTabControl components
例を見るために。
アップデートこのサンプルを確認してください
unit Unit138;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs;
type
TForm138 = class(TForm)
procedure FormCreate(Sender: TObject);
private
procedure CreateParams(var Params:TCreateParams); override;
public
end;
var
Form138: TForm138;
implementation
Uses
Vcl.Themes,
Vcl.Styles,
uPatch;
{$R *.dfm}
procedure TForm138.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := WS_EX_TRANSPARENT or WS_EX_TOPMOST;
end;
procedure TForm138.FormCreate(Sender: TObject);
begin
Brush.Style:=bsClear;
BorderStyle:=bsNone;
end;
initialization
TStyleManager.Engine.UnRegisterStyleHook(TForm, TFormStyleHook);//unregister the original style hook
TStyleManager.Engine.RegisterStyleHook(TForm, TMyStyleHookClass); //register the new style hook
end.
新しいスタイルのフッククラス
unit uPatch;
interface
uses
Vcl.Graphics,
Vcl.Forms;
type
TMyStyleHookClass= class(TFormStyleHook)
protected
procedure PaintBackground(Canvas: TCanvas); override;
end;
implementation
uses
Winapi.Windows,
System.Types,
Vcl.Themes;
procedure TMyStyleHookClass.PaintBackground(Canvas: TCanvas);
{This is only a basic sample for fix a specific scenario}
var
Details: TThemedElementDetails;
R: TRect;
begin
if StyleServices.Available then
begin
if (GetWindowLong(Form.Handle,GWL_EXSTYLE) AND WS_EX_TRANSPARENT) = WS_EX_TRANSPARENT then
if Form.Brush.Style = bsClear then Exit;
Details.Element := teWindow;
Details.Part := 0;
R := Rect(0, 0, Control.ClientWidth, Control.ClientHeight);
StyleServices.DrawElement(Canvas.Handle, Details, R);
end;
end;
end.
他のヒント
別のメモで、あなたは TransparentColor
と TranparentColorValue
ウィンドウスタイルを操作する代わりにプロパティ CreateParams()
?
NC領域のドロースタイルを防ぐために、OverridePaintnc:= Falseを使用します。また、Overrideerasebkgndもあります。多分これは助けになります。