how to make a transparent form when a VCL Style is enabled?
Asked Answered
V

3

11

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.

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.

Exist another way to make a form transparent to workaround this issue?

Vestal answered 29/11, 2011 at 20:55 Comment(0)
F
12

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. check this article Fixing a VCL Style bug in the TPageControl and TTabControl components to see an example.

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.

The New Style Hook Class

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.
Flat answered 29/11, 2011 at 21:57 Comment(0)
R
2

On a separate note, have you tried using the TransparentColor and TranparentColorValue properties instead of manipulating the window styles in CreateParams()?

Ringhals answered 29/11, 2011 at 22:58 Comment(3)
Yes i Tried but doesn't work. I set these values TransparentColor:=True; TransparentColorValue:=TStyleManager.ActiveStyle.GetStyleColor(scGenericBackground);Vestal
Are you sure scGenericBackground is the right color actually being used during painting, and that GetStyleColor() is returning the correct TColor value? Have you tried hard-coding the TransparentColorValue property to a specific TColor value that you know is being shown onscreen?Ringhals
I'm pretty sure, maybe can you edit your question adding the code which you suggest?.Vestal
S
1

I use OverridePaintNC := False to prevent draw Styles on NC area. And there is OverrideEraseBkgnd too. Maybe this help.

Slack answered 29/11, 2011 at 23:59 Comment(0)

© 2022 - 2024 — McMap. All rights reserved.