Delphi 如何在WS_EX_分层表单上绘制控件？

我用这段代码画了一个透明的纯色

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  BlendFunction: TBlendFunction;
  BitmapPos: TPoint;
  BitmapSize: TSize;
  exStyle: DWORD;
  Bitmap: TBitmap;
begin
  exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
  if (exStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  Bitmap := TBitmap.Create;
  try
    Bitmap.PixelFormat := pf32bit;
    Bitmap.SetSize(Width, Height);
    Bitmap.Canvas.Brush.Color:=clRed;
    Bitmap.Canvas.FillRect(Rect(0,0, Bitmap.Width, Bitmap.Height));
    BitmapPos := Point(0, 0);
    BitmapSize.cx := Bitmap.Width;
    BitmapSize.cy := Bitmap.Height;
    BlendFunction.BlendOp := AC_SRC_OVER;
    BlendFunction.BlendFlags := 0;
    BlendFunction.SourceConstantAlpha := 150;
    BlendFunction.AlphaFormat := 0;

    UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, Bitmap.Canvas.Handle,
      @BitmapPos, 0, @BlendFunction, ULW_ALPHA);

    Show;
  finally
    Bitmap.Free;
  end;
end;

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);
begin
  Message.Result := HTCAPTION;
end;

end. 

但是没有一个控件出现在表单中，我已经阅读了这个问题，但是使用LWA_COLORKEY或LWA_ALPHA的

SetLayeredWindowAttributes

（如公认的答案所示）不起作用

---

可以使用

UpdateLayeredWindow

函数以分层形式绘制控件（TButton，TEdit）

我在问题注释中引用的文档有点模糊。下面（msdn）中的引用更加明确，因为如果要使用

UpdateLayeredWindows

，您将无法使用VCL提供的内置绘画框架。这意味着，您只能看到位图上绘制的内容

要使用UpdateLayeredWindow，请将 分层窗口必须渲染成兼容的位图。然后，通过 在兼容的GDI设备上下文中，位图提供给 UpdateLayeredWindowAPI，以及所需的 颜色键和alpha混合信息。位图还可以包含 每像素alpha信息

请注意，使用UpdateLayeredWindow时，应用程序不需要响应WM_PAINT或其他绘制 消息，因为它已经提供了可视表示 对于窗口，系统将负责存储该图像， 合成它，并在屏幕上渲染它。 UpdateLayeredWindow功能非常强大，但通常 需要修改现有Win32应用程序的绘制方式

下面的代码试图演示如何在应用视觉效果之前，使用表单的

painto

方法使VCL为您预渲染位图（我并不是建议使用此方法，只是尝试显示需要做什么）。另外，请注意，如果您要做的只是“制作一种纯色半透明的形式”，特拉马在对问题的评论中提出的建议就是要走的路

我将代码放在

WM_PRINTCLIENT

中，以获得一个活动表单。但这有点毫无意义，因为并非所有需要视觉指示的操作都会触发“WM_PRINTCLIENT”。例如，在下面的项目中，单击按钮或复选框将反映在表单外观上，但在备忘录中写入则不会

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
    procedure WMPrintClient(var Msg: TWMPrintClient); message WM_PRINTCLIENT;
  private
    FBitmap: TBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const
  Alpha = $D0;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBitmap := TBitmap.Create;
  FBitmap.PixelFormat := pf32bit;
  FBitmap.SetSize(Width, Height);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;


procedure TForm1.WMPrintClient(var Msg: TWMPrintClient);
var
  exStyle: DWORD;
  ClientOrg: TPoint;
  X, Y: Integer;
  Pixel: PRGBQuad;
  BlendFunction: TBlendFunction;
  BitmapPos: TPoint;
  BitmapSize: TSize;
begin
  exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
  if (exStyle and WS_EX_LAYERED = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  // for non-client araea only
  FBitmap.Canvas.Brush.Color := clBtnShadow;
  FBitmap.Canvas.FillRect(Rect(0,0, FBitmap.Width, FBitmap.Height));

  // paste the client image
  ClientOrg.X := ClientOrigin.X - Left;
  ClientOrg.Y := ClientOrigin.Y - Top;
  FBitmap.Canvas.Lock;
  PaintTo(FBitmap.Canvas.Handle, ClientOrg.X, ClientOrg.Y);
  FBitmap.Canvas.Unlock;

  // set alpha and have pre-multiplied color values
  for Y := 0 to (FBitmap.Height - 1) do begin
    Pixel := FBitmap.ScanLine[Y];
    for X := 0 to (FBitmap.Width - 1) do begin
      Pixel.rgbRed := MulDiv($FF, Alpha, $FF);    // red tint
      Pixel.rgbGreen := MulDiv(Pixel.rgbGreen, Alpha, $FF);
      Pixel.rgbBlue := MulDiv(Pixel.rgbBlue, Alpha, $FF);
      Pixel.rgbReserved := Alpha;
      Inc(Pixel);
    end;
  end;

  BlendFunction.BlendOp := AC_SRC_OVER;
  BlendFunction.BlendFlags := 0;
  BlendFunction.SourceConstantAlpha := 255;
  BlendFunction.AlphaFormat := AC_SRC_ALPHA;

  BitmapPos := Point(0, 0);
  BitmapSize.cx := Width;
  BitmapSize.cy := Height;
  UpdateLayeredWindow(Handle, 0, nil, @BitmapSize, FBitmap.Canvas.Handle,
      @BitmapPos, 0, @BlendFunction, ULW_ALPHA);
end;

上面的表单如下所示：

---

你总是可以在表单上创建表单。这不是最快乐的解决方案，但它很有效。我认为解决这个问题的最佳方法是使用GDI+或D2D，但不幸的是，我无法解决它，所以我采用了“表单对表单”的方法：

分层形式：

unit uLayeredForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, System.Types,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.PngImage;

type
  TfrmLayered = class(TForm)
    procedure FormActivate(Sender: TObject);
  private
    FParentForm: TForm;
    procedure SetAlphaBackground(const AResourceName: String);
  public
    constructor Create(AOwner: TComponent; const ABitmapResourceName: String); reintroduce;
    procedure UpdatePosition;
  end;

var
  frmLayered: TfrmLayered;

implementation

{$R *.dfm}


constructor TfrmLayered.Create(AOwner: TComponent; const ABitmapResourceName: String);
begin
  inherited Create(AOwner);

  FParentForm := AOwner as TForm;
  SetAlphaBackground(ABitmapResourceName);
end;

procedure TfrmLayered.FormActivate(Sender: TObject);
begin
  if (Active) and (FParentForm.Visible) and (Assigned(FParentForm)) then
    FParentForm.SetFocus;
end;

procedure TfrmLayered.UpdatePosition;
begin
  if Assigned(FParentForm) then
  begin
    Left := FParentForm.Left - (ClientWidth - FParentForm.ClientWidth) div 2 - 1;
    Top := FParentForm.Top - (ClientHeight - FParentForm.ClientHeight) div 2 - 1;
  end;
end;

procedure TfrmLayered.SetAlphaBackground(const AResourceName: String);
var
  blend_func: TBlendFunction;
  imgpos    : TPoint;
  imgsize   : TSize;
  exStyle   : DWORD;
  png       : TPngImage;
  bmp       : TBitmap;
begin
  // enable window layering
  exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
  if ((exStyle and WS_EX_LAYERED) = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  png := TPngImage.Create;
  try
    png.LoadFromResourceName(HInstance, AResourceName);

    bmp := TBitmap.Create;
    try
      bmp.Assign(png);

      // resize the form
      ClientWidth := bmp.Width;
      ClientHeight := bmp.Height;

      // position image on form
      imgpos := Point(0, 0);
      imgsize.cx := bmp.Width;
      imgsize.cy := bmp.Height;

      // setup alpha blending parameters
      blend_func.BlendOp := AC_SRC_OVER;
      blend_func.BlendFlags := 0;
      blend_func.SourceConstantAlpha := 255;
      blend_func.AlphaFormat := AC_SRC_ALPHA;

      UpdateLayeredWindow(Handle, 0, nil, @imgsize, bmp.Canvas.Handle, @imgpos, 0, @blend_func, ULW_ALPHA);
    finally
      bmp.Free;
    end;
  finally
    png.Free;
  end;
end;

end.

unit uMainForm;

interface

uses
  uLayeredForm, 
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TfrmMain = class(TForm)
    imgClose: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure imgCloseClick(Sender: TObject);
  private
    FLayeredForm: TfrmLayered;
  protected
    procedure WMMove(var AMessage: TMessage); message WM_MOVE;
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses
  uCommon, Vcl.Themes, Vcl.Styles.FormStyleHooks;



procedure TfrmMain.FormCreate(Sender: TObject);
begin
  {$IFDEF DEBUG} ReportMemoryLeaksOnShutdown := TRUE; {$ENDIF}

  FLayeredForm := TfrmLayered.Create(self, 'MainBackground');
  FLayeredForm.Visible := TRUE;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FLayeredForm.Free;
end;

procedure TfrmMain.FormHide(Sender: TObject);
begin
  FLayeredForm.Hide;
end;

procedure TfrmMain.WMMove(var AMessage: TMessage);
begin
  if Assigned(FLayeredForm) then
    FLayeredForm.UpdatePosition;

  inherited;
end;

procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FormMove(self, Button, Shift, X, Y);
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  if Assigned(FLayeredForm) then
  begin
    FLayeredForm.Show;
    FLayeredForm.UpdatePosition;
  end;
end;

procedure TfrmMain.imgCloseClick(Sender: TObject);
begin
  Close;
end;

initialization
  TStyleManager.Engine.RegisterStyleHook(TfrmMain, TFormStyleHookBackground);
  TFormStyleHookBackground.BackGroundSettings.Color := clBlack;
  TFormStyleHookBackground.BackGroundSettings.Enabled := TRUE;

end.

主要形式：

unit uLayeredForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, System.Types,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.PngImage;

type
  TfrmLayered = class(TForm)
    procedure FormActivate(Sender: TObject);
  private
    FParentForm: TForm;
    procedure SetAlphaBackground(const AResourceName: String);
  public
    constructor Create(AOwner: TComponent; const ABitmapResourceName: String); reintroduce;
    procedure UpdatePosition;
  end;

var
  frmLayered: TfrmLayered;

implementation

{$R *.dfm}


constructor TfrmLayered.Create(AOwner: TComponent; const ABitmapResourceName: String);
begin
  inherited Create(AOwner);

  FParentForm := AOwner as TForm;
  SetAlphaBackground(ABitmapResourceName);
end;

procedure TfrmLayered.FormActivate(Sender: TObject);
begin
  if (Active) and (FParentForm.Visible) and (Assigned(FParentForm)) then
    FParentForm.SetFocus;
end;

procedure TfrmLayered.UpdatePosition;
begin
  if Assigned(FParentForm) then
  begin
    Left := FParentForm.Left - (ClientWidth - FParentForm.ClientWidth) div 2 - 1;
    Top := FParentForm.Top - (ClientHeight - FParentForm.ClientHeight) div 2 - 1;
  end;
end;

procedure TfrmLayered.SetAlphaBackground(const AResourceName: String);
var
  blend_func: TBlendFunction;
  imgpos    : TPoint;
  imgsize   : TSize;
  exStyle   : DWORD;
  png       : TPngImage;
  bmp       : TBitmap;
begin
  // enable window layering
  exStyle := GetWindowLongA(Handle, GWL_EXSTYLE);
  if ((exStyle and WS_EX_LAYERED) = 0) then
    SetWindowLong(Handle, GWL_EXSTYLE, exStyle or WS_EX_LAYERED);

  png := TPngImage.Create;
  try
    png.LoadFromResourceName(HInstance, AResourceName);

    bmp := TBitmap.Create;
    try
      bmp.Assign(png);

      // resize the form
      ClientWidth := bmp.Width;
      ClientHeight := bmp.Height;

      // position image on form
      imgpos := Point(0, 0);
      imgsize.cx := bmp.Width;
      imgsize.cy := bmp.Height;

      // setup alpha blending parameters
      blend_func.BlendOp := AC_SRC_OVER;
      blend_func.BlendFlags := 0;
      blend_func.SourceConstantAlpha := 255;
      blend_func.AlphaFormat := AC_SRC_ALPHA;

      UpdateLayeredWindow(Handle, 0, nil, @imgsize, bmp.Canvas.Handle, @imgpos, 0, @blend_func, ULW_ALPHA);
    finally
      bmp.Free;
    end;
  finally
    png.Free;
  end;
end;

end.

unit uMainForm;

interface

uses
  uLayeredForm, 
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls;

type
  TfrmMain = class(TForm)
    imgClose: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure imgCloseClick(Sender: TObject);
  private
    FLayeredForm: TfrmLayered;
  protected
    procedure WMMove(var AMessage: TMessage); message WM_MOVE;
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses
  uCommon, Vcl.Themes, Vcl.Styles.FormStyleHooks;



procedure TfrmMain.FormCreate(Sender: TObject);
begin
  {$IFDEF DEBUG} ReportMemoryLeaksOnShutdown := TRUE; {$ENDIF}

  FLayeredForm := TfrmLayered.Create(self, 'MainBackground');
  FLayeredForm.Visible := TRUE;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FLayeredForm.Free;
end;

procedure TfrmMain.FormHide(Sender: TObject);
begin
  FLayeredForm.Hide;
end;

procedure TfrmMain.WMMove(var AMessage: TMessage);
begin
  if Assigned(FLayeredForm) then
    FLayeredForm.UpdatePosition;

  inherited;
end;

procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FormMove(self, Button, Shift, X, Y);
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  if Assigned(FLayeredForm) then
  begin
    FLayeredForm.Show;
    FLayeredForm.UpdatePosition;
  end;
end;

procedure TfrmMain.imgCloseClick(Sender: TObject);
begin
  Close;
end;

initialization
  TStyleManager.Engine.RegisterStyleHook(TfrmMain, TFormStyleHookBackground);
  TFormStyleHookBackground.BackGroundSettings.Color := clBlack;
  TFormStyleHookBackground.BackGroundSettings.Enabled := TRUE;

end.

正如您所看到的，您将不得不做一些手工工作，以使两个表单作为一个，但这段代码应该让您开始

因为我需要平滑的圆形边框，所以我最终得到的结果是以下截图。我将顶部表格涂成灰色，特别是针对这篇文章，以便于区分它和黑色分层表格：

---

您可以清楚地看到别名灰色表单边框（由和CreateRoundRectRgn（）API生成）之间的区别，和抗锯齿黑色边框。

只是一个旁注。我不知道如何实现这一点，但如果要制作一个没有任何特殊形状的纯色半透明窗体，只需将设置为True和所需的alpha值；-）但在我看来，这是一个好问题；+1.我认为你的答案在第4段和第5段。基本上，如果你想继续使用你已经存在的绘画代码（VCL），使用“SetLayeredWindowAttributes”。如果要自己绘制所有内容，请使用“UpdateLayeredWindow”。@Sertac，就像

AlphaBlend

和

AlphaBlendValue

属性一样；-）