我正在使用这个代码做一个透明的纯色形式.
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)吗?
我在问题评论中提到的文档有点晦涩难懂。下面来自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)
上面的表格看起来像这样:
