comment faire une forme transparente lorsqu'un style VCL est activé?
-
25-10-2019 - |
Question
J'utilise le code suivant pour faire une forme transparente, mais lorsque l'application a un style VCL est activée la forme de peinture avec la couleur de fond du style VCL au lieu d'être 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;
Pour votre information Le code fonctionne très bien si le style est réglé sur vlc Windows
.
Existe une autre façon de faire une forme transparente pour résoudre ce problème?
La solution
Il semble comme un bug pour moi. Les styles VCL utilisent Style crochets pour intercepter les méthodes de peinture et les messages Windows liés à ces opérations, donc dans ce cas, vous devez vous concentrer votre atention dans la méthode PaintBackground
du TFormStyleHook
situé dans le Vcl.Forms
, d'ici vous créez une nouvelle classe de crochet de style (qui descend de TFormStyleHook ), remplacer la méthode PaintBackground
, corriger le code et, enfin, avant de l'utiliser appeler la méthode RegisterStyleHook pour enregistrer le nouveau crochet de style . consultez cet article Fixing a VCL Style bug in the TPageControl and TTabControl components
pour voir un exemple.
UPDATE Vérifiez cet échantillon
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.
Le nouveau style de classe crochet
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.
Autres conseils
Sur une note séparée, avez-vous essayé d'utiliser les propriétés de TransparentColor
et TranparentColorValue
au lieu de manipuler les styles de fenêtre dans CreateParams()
?
J'utilise OverridePaintNC: = False pour éviter les styles dessiner sur la zone NC. Et il y a OverrideEraseBkgnd aussi. Peut-être que cette aide.