如何绘制WS_EX_LAYERED窗体的控件？

Question

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

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. 

但是没有一个控件出现在表单中，我已经阅读了这个问题带普通画布/文本的UpdateLayeredWindow，但是使用SetLayeredWindowAttributes (正如公认的答案所示)和LWA_COLORKEY或LWA_ALPHA不起作用。

是否可以将控件(TButton，TEdit)绘制为使用UpdateLayeredWindow函数的分层形式？

Answer 1

我在对这个问题的评论中提到的文档有点模糊。下面来自使用分层窗口 (msdn)的引用更加明确，如果您要使用UpdateLayeredWindows，您将无法使用VCL提供的内置绘图框架。这意味着，你只会看到你在位图上画的东西。

要使用UpdateLayeredWindow，，分层窗口的可视位必须呈现到兼容的位图中。然后，通过兼容的GDI设备上下文，将位图提供给UpdateLayeredWindow API，以及所需的颜色键和α混合信息。位图也可以包含每像素阿尔法信息. 请注意，当使用UpdateLayeredWindow时，应用程序不需要响应WM_PAINT或其他绘图消息，因为它已经为窗口提供了可视化表示，系统将负责存储该图像、组合图像并在屏幕上呈现它。UpdateLayeredWindow非常强大，但它通常需要修改现有Win32应用程序的绘制方式。

下面的代码试图演示如何在应用视觉效果之前，通过使用表单的PaintTo方法使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;

上述表格如下所示：

​

Answer 2

您总是可以在表单上创建表单。这不是最幸福的解决办法，但有效。我认为解决这个问题的最好方法是使用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.

正如您所看到的，您需要做一些手工工作才能使两种表单成为一体，但是这段代码应该会让您开始工作。

由于我需要的格式与光滑的圆角边框，下面的截图是我得到的最终结果。我用灰色涂上了顶部的颜色，特别是为了这篇文章，为了更容易区分它和分层的黑色形式：

​

​

您可以清楚地看到别名灰色窗体边框(由SetWindowRgn()和CreateRoundRectRgn() API创建)和反别名黑色窗体边框之间的区别。