[英]how to make a transparent form when a VCL Style is enabled?
I'm using the following code to make a form transparent, but when the application has a VCL style enabled the form is paint with the background color of the VCL style instead of be transparent. 我正在使用以下代码使表单透明,但是当应用程序启用了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;
FYI The code works fine if the the vcl style is set to Windows
. 仅供参考如果将vcl样式设置为Windows
则代码可以正常工作。
Exist another way to make a form transparent to workaround this issue? 还有另一种方法可以使表单透明以解决此问题吗?
It seems like a bug to me. 这对我来说似乎是个错误。 The VCL Styles use Style hooks to intercept the paint methods and the Windows messages related to these operations, So in this case you must focus your atention in the PaintBackground
method of the TFormStyleHook
class located in the Vcl.Forms
, from here you create a new style hook class (which descends from TFormStyleHook ), override the PaintBackground
method, fix the code and finally before to use it call the RegisterStyleHook method to register the New style hook . 该VCL样式使用样式钩子拦截涂料的方法和有关这些操作的Windows消息,所以在这种情况下,你必须集中你atention在PaintBackground
的方法TFormStyleHook
地处类Vcl.Forms
,从这里你创建一个新的样式钩子类(来自TFormStyleHook ),重写PaintBackground
方法,修复代码,最后在使用之前调用RegisterStyleHook方法来注册New 样式钩子 。 check this article Fixing a VCL Style bug in the TPageControl and TTabControl components
to see an example. 查看本文Fixing a VCL Style bug in the TPageControl and TTabControl components
以查看示例。
UPDATE Check this sample 更新检查此样本
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()
中操作窗口样式?
I use OverridePaintNC := False to prevent draw Styles on NC area. 我使用OverridePaintNC:= False来防止在NC区域上绘制样式。 And there is OverrideEraseBkgnd too. 而且还有OverrideEraseBkgnd。 Maybe this help. 也许这有帮助。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.