如何在WS_EX_LAYERED表单上绘制控件?

Sal*_*dor 6 delphi winapi

我正在使用这个代码做一个透明的纯色形式.

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. 
Run Code Online (Sandbox Code Playgroud)

但是没有一个控件出现在表单中,我已经用普通的canvas/textout读取了这个问题UpdateLayeredWindow,但是使用SetLayeredWindowAttributesLWA_COLORKEY或LWA_ALPHA不能正常使用(作为接受的答案提示).

有可能以分层形式绘制一个使用该UpdateLayeredWindow函数的控件(TButton,TEdit)吗?

Ser*_*yuz 4

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

要使用UpdateLayeredWindow,分层窗口的视觉位必须呈现为兼容的位图。然后,通过兼容的 GDI 设备上下文,将位图以及所需的颜色键和 alpha 混合信息提供给 UpdateLayeredWindow API。位图还可以包含每个像素的 Alpha 信息。

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


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

我已将代码放入 a 中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;
Run Code Online (Sandbox Code Playgroud)


上面的表格看起来像这样:
半透明形式