How draw a control over a WS_EX_LAYERED form?

Question

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?

Answer 1

You can always create form on form. It's not happiest solution, but it works. I beleive the best way to solve this problem would be by utilizing GDI+ or D2D, but unfortunately, I couldn't figure it out, so I went with "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.

Main 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 do a bit of manual work to make two forms behave as one, but this code should get you started.

Since I needed form with smooth rounded borders, following screenshot is what I got as an end result. I coloured top form in gray, specifically for this post, for easier distinction between it and layered black form:

You can clearly see the difference between aliased gray form borders (made by SetWindowRgn() and CreateRoundRectRgn() APIs), and antialiased black form borders.

Answer 2

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: