I'm using this code do draw a transparent form of a solid color.
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.
But none of the controls appears in the form , already I read this question UpdateLayeredWindow with normal canvas/textout but using SetLayeredWindowAttributes
(as the accepted answer suggest) with LWA_COLORKEY or LWA_ALPHA is not working.
It's possible draw a control (TButton , TEdit) in a layered form which uses the UpdateLayeredWindow
function?
The documentation I refferred in the comment to the question is a bit obscure. The quote below from Using Layered Windows (msdn) is much more explicit in that, if you're going to use UpdateLayeredWindows
you won't be able to use VCL supplied built-in painting framework. The implication is that, you'll only see what you've drawn on the bitmap.
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.
Following code is an attempt to demonstrate how you can make the VCL pre-render the bitmap for you by using the PaintTo
method of the form, before you apply your visual effects ( (it's not that I'm suggesting the use of this method, just trying to show what it would take to..). Also please note that, if all you're going to do is to "make a solid color semi-transparent form", TLama's suggestion in the comments to the question is the way to go.
I've put the code in a WM_PRINTCLIENT
to have a live form. This is a bit pointless though, because not all actions requiring a visual indication will trigger a 'WM_PRINTCLIENT'. For instance in the below project, clicking the button or the check-box will be reflected on the form appearance, but writing in the memo will not.
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;
The above form looks like this:
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With