欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

Delphi 实现不规则窗体

程序员文章站 2022-06-15 15:00:37
最近为了要兼容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 实现不规则窗体

7.效果 (箭头指向处)

Delphi 实现不规则窗体

ps:delphi初学,敬请见谅(边学边做,大概花了5天时间)