How to gain control over the WS_EX_LAYERED form?

Question

I use this code, draw a transparent solid color shape.

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 on the form, I already read this UpdateLayeredWindow question with a normal canvas / text display , but using SetLayeredWindowAttributes (as a suggested answer) with LWA_COLORKEY or LWA_ALPHA does not work.

Is it possible to use a control (TButton, TEdit) in a layered form that uses the UpdateLayeredWindow function?

Answer 1

The documentation that I repeated in the comment on the question is a bit unclear. The quote from Using layered Windows (msdn) is much more pronounced in that if you intend to use UpdateLayeredWindows , you won’t be able to use the built-in border to draw VCL. It is understood that you will only see what you painted on the bitmap.

To use UpdateLayeredWindow, visual bits for multi-level window to be displayed in a compatible bitmap. Then, through the compatible GDI device context, the bitmap is provided by UpdateLayeredWindow , as well as the desired color key and alpha blend. The bitmap may also contain for pixel alpha information.

Please note that when using UpdateLayeredWindow, the application should not respond to WM_PAINT or another picture of messages, since it has already presented a visual representation for the window and the system will take care of saving this image, composing it and displaying it on the screen. UpdateLayeredWindow is powerful enough, but often requires a change in the way you create an existing Win32 application.

The following code is an attempt to demonstrate how you can do VCL pre-rendering for a bitmap using the PaintTo method of the form before applying visual effects ((not what I suggest using this method, just trying to show what it will do ... ) Also note that if all you are going to do is “make a solid translucent color shape,” TLama's suggestion in the comments on the question is the way to go.

I put the code in WM_PRINTCLIENT to have a live form. This is a little pointless because not all actions requiring a visual indication will call "WM_PRINTCLIENT". For example, in the project below, clicking a button or flag will be reflected in the appearance of the form, but there will be no entry in the note.

 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 is as follows:

Answer 2

You can always create a form in a form. This is not a happy solution, but it works. I believe that the best way to solve this problem is to use GDI + or D2D, but unfortunately I could not understand, so I went with the "form on form" approach:

Layered form:

 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. 

Basic form:

 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. 

As you can see, you will have to work a bit so that the two forms behave as one, but this code should start.

Since I need a shape with smooth rounded borders, the following screenshot is what I got as the final result. I painted the upper shape in gray, especially for this post, for a simpler distinction between it and the layered black shape:

You can clearly see the difference between the borders in a smoothed gray font (made by SetWindowRgn () and the CreateRoundRectRgn () API) and the smoothed black shapes.