【问题标题】:how to make a transparent form when a VCL Style is enabled?启用 VCL 样式时如何制作透明表单?
【发布时间】:2011-11-29 20:55:52
【问题描述】:

我正在使用以下代码使表单透明,但是当应用程序启用了 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,则代码可以正常工作。

是否存在另一种使表单透明以解决此问题的方法?

【问题讨论】:

    标签: delphi delphi-xe2 vcl-styles


    【解决方案1】:

    对我来说这似乎是一个错误。 VCL Styles 使用 Style hooks 来拦截与这些操作相关的绘制方法和 Windows 消息,因此在这种情况下,您必须将注意力集中在位于 TFormStyleHook 类的 PaintBackground 方法上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.
    

    【讨论】:

      【解决方案2】:

      另外,您是否尝试过使用TransparentColorTranparentColorValue 属性而不是在CreateParams() 中操作窗口样式?

      【讨论】:

      • 是的,我试过了,但没有用。我设置了这些值TransparentColor:=True; TransparentColorValue:=TStyleManager.ActiveStyle.GetStyleColor(scGenericBackground);
      • 您确定scGenericBackground 是在绘画过程中实际使用的正确颜色,并且GetStyleColor() 正在返回正确的TColor 值吗?您是否尝试将 TransparentColorValue 属性硬编码为您知道屏幕上显示的特定 TColor 值?
      • 我很确定,也许您可​​以编辑您的问题并添加您建议的代码?
      【解决方案3】:

      我使用 OverridePaintNC := False 来防止在 NC 区域上绘制样式。还有 OverrideEraseBkgnd。也许这有帮助。

      【讨论】:

        猜你喜欢
        • 2022-01-12
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        • 2012-08-25
        • 2013-06-05
        • 1970-01-01
        • 1970-01-01
        • 1970-01-01
        相关资源
        最近更新 更多