Delphi 实现不规则窗体

最近为了要兼容XP系统（守旧的市场），又需要做出产品的特效，不得不从头学习一下这门 “聪明的语言” 。

开发环境： win10 Delphi 10.2 Version 25.0.26309.314

产品环境：最低xp系统

使用 http://www.bilsen.com/gdiplus/index.shtml  网站下载中的 Gdi+ 1.0

1. 项目dpr文件中引用即可：

uses GdiPlus in '..\PublicLib\GdiPlus\GdiPlus.pas', (本机电脑的存放目录)

2. 新建Vcl 窗体

3. 来一波代码（绘制不规则窗体，当然是在窗体创建的时候调用）

TFormPrimary 自建窗体 IrregularInterface 自定义函数（ImageFile 为不规则图片的路径）

 procedure TFormPrimary.IrregularInterface(ImageFile: string);
 var
   Bitmap: IGPBitMap;
   BlendFunc: TBlendFunction;
   Sz : TSize;
   Dc : HDC;
   Bmp,BmpOld : HBITMAP;
   PtDst, PtSrc : TPoint;
 begin
   Bitmap := TGPBitmap.Create(ImageFile);

   Sz.cx := Bitmap.Width;
   Sz.cy := Bitmap.Height;

   PtDst := TPoint.Create(left,top);
   PtSrc := TPoint.Create(, );

   BlendFunc.BlendOp := AC_SRC_OVER;
   BlendFunc.BlendFlags := ;
   BlendFunc.AlphaFormat := AC_SRC_ALPHA;
   BlendFunc.SourceConstantAlpha := ;

   Bmp := Bitmap.GetHBitmap();
   Dc:= CreateCompatibleDC(Canvas.Handle);
   BmpOld := SelectObject(Dc,Bmp);

   SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
   UpdateLayeredWindow(Handle, Canvas.Handle , @PtDst, @Sz, Dc, @PtSrc,,@BlendFunc,ULW_ALPHA);

   SelectObject(Dc,BmpOld);
   DeleteObject(Bmp);
   DeleteDC(Dc);
 end;

4.再来一波 （窗体随着鼠标拖动）

     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
   private
     { Private declarations }
     OldPos:TPoint;
     Move:Boolean;

5.最后一波 （窗体拖动的实现）

 procedure TFormPrimary.FormMouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
   Move := True;
   GetCursorPos(OldPos);
 end;

 procedure TFormPrimary.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
 var
   NewPos: TPoint;
 begin
   if not Move then Exit;
   GetCursorPos(NewPos);
   Left := Left + (NewPos.X - OldPos.X);
   Top := Top + (NewPos.Y - OldPos.Y);
   GetCursorPos(OldPos);
 end;

 procedure TFormPrimary.FormMouseUp(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 begin
   Move := False;
 end;

6.最后的是vcl窗体的Style

7.效果 （箭头指向处）

Ps：Delphi初学，敬请见谅（边学边做，大概花了5天时间）