Delphi 实现不规则窗体

程序员文章站 2022-03-03 08:17:47

最近为了要兼容XP系统（守旧的市场），又需要做出产品的特效，不得不从头学习一下这门 “聪明的语言” 。开发环境： win10 Delphi 10.2 Version 25.0.26309.314 产品环境：最低xp系统使用 http://www.bilsen.com/gdiplus/index. ......

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

开发环境： win10 delphi 10.2 version 25.0.26309.314

产品环境：最低xp系统

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

Delphi 实现不规则窗体

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

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

2. 新建vcl 窗体

Delphi 实现不规则窗体

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

tformprimary 自建窗体 irregularinterface 自定义函数（imagefile 为不规则图片的路径）

 1 procedure tformprimary.irregularinterface(imagefile: string);
 2 var
 3   bitmap: igpbitmap;
 4   blendfunc: tblendfunction;
 5   sz : tsize;
 6   dc : hdc;
 7   bmp,bmpold : hbitmap;
 8   ptdst, ptsrc : tpoint;
 9 begin
10   bitmap := tgpbitmap.create(imagefile);
11 
12   sz.cx := bitmap.width;
13   sz.cy := bitmap.height;
14 
15   ptdst := tpoint.create(left,top);
16   ptsrc := tpoint.create(0, 0);
17 
18   blendfunc.blendop := ac_src_over;
19   blendfunc.blendflags := 0;
20   blendfunc.alphaformat := ac_src_alpha;
21   blendfunc.sourceconstantalpha := 255;
22 
23   bmp := bitmap.gethbitmap(0);
24   dc:= createcompatibledc(canvas.handle);
25   bmpold := selectobject(dc,bmp);
26 
27   setwindowlong(handle, gwl_exstyle, getwindowlong(handle, gwl_exstyle) or ws_ex_layered);
28   updatelayeredwindow(handle, canvas.handle , @ptdst, @sz, dc, @ptsrc,0,@blendfunc,ulw_alpha);
29 
30   selectobject(dc,bmpold);
31   deleteobject(bmp);
32   deletedc(dc);
33 end;

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

1     procedure formmousedown(sender: tobject; button: tmousebutton;
2       shift: tshiftstate; x, y: integer);
3     procedure formmouseup(sender: tobject; button: tmousebutton;
4       shift: tshiftstate; x, y: integer);
5     procedure formmousemove(sender: tobject; shift: tshiftstate; x, y: integer);
6   private
7     { private declarations }
8     oldpos:tpoint;
9     move:boolean;

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

 1 procedure tformprimary.formmousedown(sender: tobject; button: tmousebutton;
 2   shift: tshiftstate; x, y: integer);
 3 begin
 4   move := true;
 5   getcursorpos(oldpos);
 6 end;
 7 
 8 procedure tformprimary.formmousemove(sender: tobject; shift: tshiftstate; x,
 9   y: integer);
10 var
11   newpos: tpoint;
12 begin
13   if not move then exit;
14   getcursorpos(newpos);
15   left := left + (newpos.x - oldpos.x);
16   top := top + (newpos.y - oldpos.y);
17   getcursorpos(oldpos);
18 end;
19 
20 procedure tformprimary.formmouseup(sender: tobject; button: tmousebutton;
21   shift: tshiftstate; x, y: integer);
22 begin
23   move := false;
24 end;

6.最后的是vcl窗体的style

Delphi 实现不规则窗体