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?

Était-ce utile?

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.

Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top