Delphi 启用VCL样式时,如何生成透明窗体?
我使用以下代码使窗体透明,但当应用程序启用VCL样式时,窗体将使用VCL样式的背景色绘制,而不是透明Delphi 启用VCL样式时,如何生成透明窗体?,delphi,delphi-xe2,vcl-styles,Delphi,Delphi Xe2,Vcl Styles,我使用以下代码使窗体透明,但当应用程序启用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(Se
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
,代码工作正常
是否存在另一种使表单透明的方法来解决此问题?对我来说,这似乎是一个bug。VCL样式使用样式钩子来截获绘制方法和与这些操作相关的Windows消息,因此在这种情况下,您必须将注意力集中在位于
VCL.Forms
中的类的PaintBackground
方法中,从这里您可以创建一个新的样式钩子类(从TFormStyleHook派生),重写PaintBackground
方法,修复代码,最后在使用它之前调用RegisterStyleHook方法来注册新样式挂钩。查看本文以查看示例
更新
检查一下这个样品
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.
新型钩子类
另一方面,您是否尝试过使用
TransparentColor
和transparentColorValue
属性,而不是在CreateParams()
中操作窗口样式?我使用OverridePaintNC:=False来防止在NC区域绘制样式。还有一个是OverrideEraseBkgnd。也许这会有帮助。是的,我试过了,但没用。我设置这些值TransparentColor:=True;TransparentColorValue:=TStyleManager.ActiveStyle.GetStyleColor(scGenericBackground)
您确定scGenericBackground
在绘制过程中实际使用的颜色正确,并且GetStyleColor()
返回的值正确吗?您是否尝试过将TransparentColorValue
属性编码为您知道屏幕上显示的特定TColor
值?我很确定,您可以编辑您的问题并添加您建议的代码吗?。
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.