delphi - 如何在 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 with normal canvas/textout但使用 SetLayeredWindowAttributes (正如接受的答案所建议的那样)与 LWA_COLORKEY 或 LWA_ALPHA 不起作用。

可以使用 UpdateLayeredWindow 函数以分层形式绘制控件(TButton、TEdit)吗？

Answer 1

我在问题评论中引用的文档有点晦涩难懂。以下引用自Using Layered Windows (msdn) 的说法更加明确，如果您要使用 UpdateLayeredWindows，您将无法使用 VCL 提供的内置绘画框架。这意味着，您只能看到您在位图上绘制的内容。

To use UpdateLayeredWindow, the visual bits for a layered window have to be rendered into a compatible bitmap. Then, via a compatible GDI Device Context, the bitmap is provided to the UpdateLayeredWindow API, along with the desired color-key and alpha-blend information. The bitmap can also contain per-pixel alpha information.

Note that when using UpdateLayeredWindow the application doesn't need to respond to WM_PAINT or other painting messages, because it has already provided the visual representation for the window and the system will take care of storing that image, composing it, and rendering it on the screen. UpdateLayeredWindow is quite powerful, but it often requires modifying the way an existing Win32 application draws.

下面的代码试图演示如何在应用视觉效果之前使用表单的 PaintTo 方法让 VCL 为您预渲染位图((这并不是我的意思)建议使用这种方法，只是想展示它需要做什么..)。另请注意，如果您要做的只是“制作一个纯色半透明表单”，TLama 在问题评论中的建议是要走的路。

我已将代码放入 WM_PRINTCLIENT 中以获得实时表单。但这有点毫无意义，因为并非所有需要视觉指示的操作都会触发“WM_PRINTCLIENT”。例如，在下面的项目中，单击按钮或复选框将反射(reflect)在表单外观上，但在备忘录中写入不会反射(reflect)。

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;

上面的表单如下所示: