制作可点击的异形窗口（2）

一、带透明效果的异形窗体
首先，封装一个函数实现带alpha效果的异形窗体。

//根据传入的参数实现异形窗体
//Wnd: 窗体句柄
//Bmp: 窗体的图像，支持alpha像素
//Alpha: 透明度，在bmp的基础上再叠加一个透明度，0为全透，255为不叠加透明度
procedure AlphaUpdateLayeredWindow(Wnd: HWND; Bmp: TBitmap; Alpha: Byte);
var
Pt: TPoint;
R: TRect;
Sz: TSize;
BF: _BLENDFUNCTION;
begin
GetWindowRect(Wnd, R);
Pt := Point(0, 0);
Sz.cx := Bmp.Width;
Sz.cY := Bmp.Height;
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := Alpha;
bf.AlphaFormat := AC_SRC_ALPHA;
SetWindowLong(wnd, GWL_EXSTYLE, GetWindowLong(wnd, GWL_EXSTYLE) or WS_EX_LAYERED);
UpdateLayeredWindow(wnd, 0, @R.TopLeft, @Sz, Bmp.Canvas.Handle, @Pt, 0, @BF, ULW_ALPHA);
end;
接着，在窗体的FormCreate事件中载入图片素材，根据图片建立异形窗体。

procedure TForm1.FormCreate(Sender: TObject);
var
png: TPngImage;
bmp: TBitmap;
begin
png := TPngImage.Create;
try
png.LoadFromFile(TPath.Combine(ExtractFilePath(Application.ExeName), ‘1.png’));
bmp := TBitmap.Create;
try
bmp.Assign(png);
AlphaUpdateLayeredWindow(Handle, bmp, 255);
finally
bmp.Free;
end;
finally
png.Free;
end;
end;
最后，添加鼠标响应，按下鼠标可以拖动它。

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
至此，一个简单的异形窗体就制作好，下面是运行时的录屏效果。
1
[运行效果，转gif后颜色会有损失]

二、增加动画
只是这个样子未免有点单调，让我们来加点动画效果，让事情变得更有趣。
在窗体上添加一个TTimer，每50ms触发一次事件。

procedure TForm1.Timer1Timer(Sender: TObject);
var
i: Integer;
begin
//每50ms重绘一次
bmp.Assign(png1);
//绘制两个光点到bmp，不断变换位置产生动画
for i := 1 to 2 do begin
bmp.Canvas.Draw(Points[i].X, Points[i].Y, png2);
UpdatePos(i);
end;
AlphaUpdateLayeredWindow(Handle, bmp, 255);
end;
bmp、Points、png等在FormCreate提取预设好，完整代码如下：

unit Unit1;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Imaging.pngimage,
Vcl.ExtCtrls, Vcl.ComCtrls, IOUtils;

type
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
//光点的绘制位置
Points: array[1…2] of TPoint;
//预载入Png图片
png1, Png2: TPngImage;
bmp: TBitmap;
procedure UpdatePos(index: integer);
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

//根据传入的参数实现异形窗体
//Wnd: 窗体句柄
//Bmp: 窗体的图像，支持alpha像素
//Alpha: 透明度，在bmp的基础上再叠加一个透明度，0为全透，255为不叠加透明度
procedure AlphaUpdateLayeredWindow(Wnd: HWND; Bmp: TBitmap; Alpha: Byte);
var
Pt: TPoint;
R: TRect;
Sz: TSize;
BF: _BLENDFUNCTION;
begin
GetWindowRect(Wnd, R);
Pt := Point(0, 0);
Sz.cx := Bmp.Width;
Sz.cY := Bmp.Height;
bf.BlendOp := AC_SRC_OVER;
bf.BlendFlags := 0;
bf.SourceConstantAlpha := Alpha;
bf.AlphaFormat := AC_SRC_ALPHA;
SetWindowLong(wnd, GWL_EXSTYLE, GetWindowLong(wnd, GWL_EXSTYLE) or WS_EX_LAYERED);
UpdateLayeredWindow(wnd, 0, @R.TopLeft, @Sz, Bmp.Canvas.Handle, @Pt, 0, @BF, ULW_ALPHA);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
FillMemory(@Points, Sizeof(Points), 0);
Points[1].X := Random(Width div 2) * 2;
//载入两个Png图片
png1 := TPngImage.Create;
png1.LoadFromFile(TPath.Combine(ExtractFilePath(Application.ExeName), ‘1.png’));
png2 := TPngImage.Create;
png2.LoadFromFile(TPath.Combine(ExtractFilePath(Application.ExeName), ‘2.png’));
bmp := TBitmap.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(png1) then png1.Free;
if Assigned(png2) then png2.Free;
if Assigned(bmp) then bmp.Free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
i: Integer;
begin
//每50ms重绘一次
bmp.Assign(png1);
//绘制两个光点到bmp，不断变换位置产生动画
for i := 1 to 2 do begin
bmp.Canvas.Draw(Points[i].X, Points[i].Y, png2);
UpdatePos(i);
end;
AlphaUpdateLayeredWindow(Handle, bmp, 255);
end;

procedure TForm1.UpdatePos(index: integer);
begin
Inc(Points[index].X, 8);
Inc(Points[index].Y, 12);
if (Points[index].X > Width) or (Points[index].Y > Height) then begin
Points[index].X := Random(Width div 3) * 3;
Points[index].Y := -10;
end;
end;

end.
这是运行后的录屏：

2