Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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.

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?

like image 608
Salvador Avatar asked Nov 29 '11 20:11

Salvador


3 Answers

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.
like image 165
RRUZ Avatar answered Oct 18 '22 02:10

RRUZ


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

like image 2
Remy Lebeau Avatar answered Oct 18 '22 00:10

Remy Lebeau


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

like image 1
netcodecz Avatar answered Oct 18 '22 01:10

netcodecz