VCLスタイルが有効になっているときに透明なフォームを作成する方法は?

StackOverflow https://stackoverflow.com/questions/8317617

  •  25-10-2019
  •  | 
  •  

質問

次のコードを使用してフォームを透明にしますが、アプリケーションに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.

この問題を回避するためにフォームを透明にする別の方法がありますか?

役に立ちましたか?

解決

私にはバグのようです。 VCLスタイルの使用 スタイルフック これらの操作に関連するペイントメソッドとWindowsメッセージを傍受するには、この場合、 PaintBackground の方法 TFormStyleHook にあります 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.

他のヒント

別のメモで、あなたは TransparentColorTranparentColorValue ウィンドウスタイルを操作する代わりにプロパティ CreateParams()?

NC領域のドロースタイルを防ぐために、OverridePaintnc:= Falseを使用します。また、Overrideerasebkgndもあります。多分これは助けになります。

ライセンス: CC-BY-SA帰属
所属していません StackOverflow
scroll top