delphi(XE2)实现图片异形窗体，支持摆放控件

网上有较多使用UpdateLayeredWindow函数实现美化的图片异形窗体的代码，一般使用此场景时，对软件界面要求较高。但是实现了图片窗体后，在窗体中摆放不了其他控件，导致这个功能很鸡肋。为解决此问题，本博文中的案例使用两个窗体搭配使用，即图片窗口作为背景窗体，放置控件的窗口作为功能性窗体，功能性窗口全透明展示，就可实现我们预设的目标，效果如下：

 蓝色的圆球是一个png格式背景图片，没有直接用画布画圆，所以不会失真。实现本功能的主要关键点在于：

1、实现异形的背景窗口

2、功能性窗口除控件部分需全透明展示

3、支持鼠标移动窗体，且两个窗口要同步位移

4、两个窗口需要以相同顺序展示在屏幕最上方

下面贴主要代码段：

{*******************************************************}
{                                                       }
{       异形窗口                                        }
{       负责美观的背景窗口                                                }
{       版权所有 (C) 2022 云露软件                      }
{                                                       }
{*******************************************************}

unit uBackground;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, acPNG, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TfrmBk = class(TForm)
    img1: TImage;
    procedure FormShow(Sender: TObject);
    procedure img1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure img1MouseEnter(Sender: TObject);
    procedure img1MouseLeave(Sender: TObject);
    procedure img1Click(Sender: TObject);
  private
    { Private declarations }
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMMove(var Message: TMessage) ; message WM_MOVE;//响应窗体移动的消息
    procedure WndProc(var Message: TMessage); override;
  public
    { Public declarations }

    class procedure ShowFrm;
  end;

var
  frmBk: TfrmBk;

implementation
  uses uMain;

{$R *.dfm}
procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);
var
  ptDst, ptSrc: TPoint;
  Size: TSize;
  BlendFunction: TBlendFunction;
  bmp : TBitmap;
begin
  bmp := TBitmap.Create;
  bmp.Assign(AGraphic);
  ptDst := Point(AForm.Left, AForm.Top);
  ptSrc := Point(0, 0);
  Size.cx := AGraphic.Width;
  Size.cy := AGraphic.Height;

  BlendFunction.BlendOp := AC_SRC_OVER;
  BlendFunction.BlendFlags := 0;
  BlendFunction.SourceConstantAlpha := $FF; // 透明度
  BlendFunction.AlphaFormat := AC_SRC_ALPHA;

  SetWindowLong(AForm.Handle, GWL_EXSTYLE, GetWindowLong(AForm.Handle,
      GWL_EXSTYLE) or WS_EX_LAYERED);
  UpdateLayeredWindow(AForm.Handle,
     AForm.Canvas.Handle,
     @ptDst,
     @Size,
     bmp.Canvas.Handle,
     @ptSrc,
     0,
     @BlendFunction,
     ULW_ALPHA);
  bmp.Free();
end;

//根据png图片更换窗体样式：
procedure RefrashFormByPng(AForm: TForm;aFileName: string);
var
  wic: TWICImage;
begin
  wic := TWICImage.Create;
  try
    wic.LoadFromFile(aFileName);
    YXForm_FromGraphic(frmBk, wic);
  finally
    FreeAndNil(wic);
  end;
end;

procedure TfrmBk.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WndParent := GetDesktopWindow ;//父窗口句柄设置为桌面
  Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW; //取消窗体在任务栏的图标
end;

procedure TfrmBk.FormShow(Sender: TObject);
begin
  //同步控件窗体展示的大小、位置
  frmMain.Width := Self.Width;
  frmMain.Height := Self.Height;
  frmMain.Left := frmBk.Left-2;
  frmMain.Top := frmBk.Top-5;
  //置顶现实
  SetWindowPos(Handle, HWND_TOPMOST , 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
  PostMessage(frmMain.Handle, WM_USER + 200, 0 , 0);
end;

procedure TfrmBk.img1Click(Sender: TObject);
begin
  if not frmMain.Showing then//如果当前展示的是退出登录
    ModalResult := mrNo;
end;

procedure TfrmBk.img1MouseEnter(Sender: TObject);
begin
  //鼠标点上去更换背景图，使用下面两句：
  RefrashFormByPng(frmBk,'退出.png');
  frmMain.Hide;
  //如果鼠标点上去仍然需要展示控件窗口，则使用下面这句：
//  SetWindowPos(Handle,HWND_NOTOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

procedure TfrmBk.img1MouseLeave(Sender: TObject);
begin
  //鼠标点上去更换背景图，使用下面两句：
  RefrashFormByPng(frmBk,'bk.png');
  SetWindowPos(Handle,HWND_TOPMOST,Left,Top,Width,Height,SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  //如果鼠标点上去仍然需要展示控件窗口，则使用下面这句：
  PostMessage(frmMain.Handle, WM_USER + 200, 0 , 0);
end;

procedure TfrmBk.img1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //鼠标拖动窗体移动：
  if ssLeft in Shift then
    ReleaseCapture;
  Perform(WM_SYSCOMMAND, $F012, 0);
end;

class procedure TfrmBk.ShowFrm;
begin
  frmBk := TfrmBk.Create(Application);
  try
    RefrashFormByPng(frmBk,'D:\HX_Code\bk.png');
    frmMain := TfrmMain.Create(Application);
    frmBk.ShowModal;
  finally
    FreeAndNil(frmBk);//不要也行，Application释放时会自动释放
  end;
end;

procedure TfrmBk.WMMove(var Message: TMessage);
begin
  if Assigned(frmMain) then
  begin
    //同步控件窗体展示的大小、位置
    frmMain.Left := frmBk.Left-2;
    frmMain.Top := frmBk.Top- 2;
    //如果鼠标点上去仍然需要展示控件窗口，则使用下面这句：
//    PostMessage(frmMain.Handle, WM_USER + 200, 0 , 0);
  end;
end;

procedure TfrmBk.WndProc(var Message: TMessage);
begin
  inherited WndProc(Message);
  if (not Application.MainFormOnTaskBar) and (Message.Msg = WM_SHOWWINDOW) then
  begin
    //取消任务栏现实
    ShowWindow(Application.Handle, SW_HIDE);
    SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
  end;
end;

end.

{*******************************************************}
{                                                       }
{       功能窗口                                        }
{       主要摆放控件，实现一些业务逻辑                  }
{       版权所有 (C) 2022 云露软件                      }
{                                                       }
{*******************************************************}

unit uMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, cxGraphics, cxControls,
  cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit, cxLabel,
  Vcl.ExtCtrls;

type
  TfrmMain = class(TForm)
    cxLabel1: TcxLabel;
    tmr1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
    i: Integer;
    procedure WMSHOW(var Msg: TMessage); message WM_USER + 200;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation
  uses uBackground;
{$R *.dfm}

procedure TfrmMain.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.WndParent := GetDesktopWindow ;//父窗口设为桌面，不会被其他窗口遮挡
  Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW; //取消窗体在任务栏的图标
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  mStyle, mExStyle: Longint;
begin
  //设置窗体为无标题
  mStyle:= GetWindowLong(Handle, GWL_STYLE);
  SetWindowLong(Handle, GWL_STYLE, mStyle and not WS_CAPTION);
  //设置窗体上指定颜色为全透明
  mExStyle:= GetWindowLong(Handle, GWL_EXSTYLE);
  SetWindowLong(Handle, GWL_EXSTYLE, mExStyle or WS_EX_LAYERED);
  SetLayeredWindowAttributes(Handle, Self.Color, 200, LWA_COLORKEY);
  i := 1;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  SetWindowPos(frmMain.Handle, HWND_TOPMOST , 0, 0, 0, 0, SWP_NOSIZE or SWP_NOMOVE);
end;

procedure TfrmMain.tmr1Timer(Sender: TObject);
begin
  inc(i);
  cxLabel1.Caption :=  IntToStr(I)+'S';
end;


procedure TfrmMain.WMSHOW(var Msg: TMessage);
begin
  Self.Show;
end;

end.

功能性窗口只有一个lable，为了让它的全透明效果更好，设置了lable居中显示，颜色为灰色（这个可以调整）。

//工程文件
program Project2;

uses
  Vcl.Forms,
  uBackground in 'uBackground.pas' {frmBk},
  uMain in 'uMain.pas' {frmMain};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := False;
  TfrmBk.ShowFrm;
  Application.Run;
end.