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

上回制作了一个用于系统升级的异形窗体（地址：https://www.cnblogs.com/kacarton/p/21013146），但只能使用实色图像，不能实现半透明的阴影效果。这次尝试制作一个带半透明效果的异形窗体。

素材图片仍然是那个火箭的png文件，再加一个光点图像，两个都是24位的PNG图像：

火箭.png

光点.png

一、带透明效果的异形窗体

首先，封装一个函数实现带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;

至此，一个简单的异形窗体就制作好，下面是运行时的录屏效果。

运行效果，转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.

这是运行后的录屏：