Delphi 实现不规则窗体

最近为了要兼容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 为不规则图片的路径)
 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

Delphi 实现不规则窗体

7.效果 (箭头指向处)

Delphi 实现不规则窗体

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

上一篇:NetFPGA


下一篇:在创建窗口句柄之前,不能在控件上调用 Invoke 或 BeginInvoke。