设为首页 加入收藏

TOP

Delphi 实现不规则窗体
2019-08-23 00:31:17 】 浏览:94
Tags: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 为不规则图片的路径)
 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天时间)

 

】【打印繁体】【投稿】【收藏】 【推荐】【举报】【评论】 【关闭】 【返回顶部
上一篇0005-20180422-自动化第六章-pyth.. 下一篇Python GUI

最新文章

热门文章

Hot 文章

Python

C 语言

C++基础

大数据基础

linux编程基础

C/C++面试题目