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
1. 项目dpr文件中引用即可:
uses gdiplus in '..\publiclib\gdiplus\gdiplus.pas', (本机电脑的存放目录)
2. 新建vcl 窗体
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
7.效果 (箭头指向处)
ps:delphi初学,敬请见谅(边学边做,大概花了5天时间)
上一篇: MVVMLight项目之双向数据绑定