制作从屏幕右下角逐渐弹出的消息提示框

制作从屏幕右下角逐渐弹出的消息提示框

微软的每一个产品，无论功能还是界面设计都会带给我们一定的惊喜，比如OfficeXP、Office2003、Messenger的界面设计，早已成为众多软件竞相模仿的对象，就拿Messenger来说，我就见过好几套网络视频会议的软件都借鉴了它的界面风格。 　　前段时间因为要在原来的软件上增加一个快捷键提示窗体，这个提示窗要求在显示的时候比较醒目美观能引起用户注意，显示后不影响用户操作，能够关掉。很自然的就想到了Messenger那个从屏幕右下角逐渐弹出的消息提示窗体，不过相对Messenger我更喜欢QQ2004奥运版的配色风格，反正都是偷就多偷点吧，下面快捷键提示窗的最终效果： 　　　　 　　这个窗体有以下几个特点： 　　1、显示的时候是从屏幕右下角逐渐弹出的； 　　2、它是个无标题窗体，但它必须允许用户移动和改变大小，因此要用到无标题窗体拖动、改变大小的技术； 　　3、它是个不规则的窗体，主要是左上角和右上角是圆形导角，因此要为窗体创建外形，且窗体改变大小时必须重建； 　　4、它标题和内容显示区都有渐层色，标题还有几个小点点，在实现时使用取巧的方法，直接利用截图进行填充。 　　当然界面可以偷，代码就得老老实实的写的了，下面是界面设计图和实现代码 unit formPSHotKey; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons; {======================================================================== DESIGN BY : 彭国辉 DATE: 2004-10-28 SITE: http://kacarton.yeah.net/ BLOG: http://blog.csdn.net/nhconch EMAIL: kacarton@sohu.com 文章为作者原创，转载前请先与本人联系，转载请注明文章出处、保留作者信息，谢谢支持！ =========================================================================} type TfrmPSHotKey = class(TForm) imgTitleBar: TImage; imgTitleBarBG: TImage; imgShapeBG: TImage; SpeedButton1: TSpeedButton; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Label7: TLabel; Label8: TLabel; Label9: TLabel; Label10: TLabel; Label11: TLabel; Label12: TLabel; Label13: TLabel; procedure FormPaint(Sender: TObject); procedure imgTitleBarMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure SpeedButton1Click(Sender: TObject); procedure Label11MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormResize(Sender: TObject); procedure Label12MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Label13MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure imgTitleBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Label11MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); private { Private declarations } public { Public declarations } end; var frmPSHotKey: TfrmPSHotKey; implementation {$R *.dfm} procedure TfrmPSHotKey.FormCreate(Sender: TObject); begin   Tag := Height;   Height := 16;   //定位到屏幕右下角 Top := Screen.Height - 40;   Left := Screen.Width - Width - 2;   Show;   //从屏幕右下角逐渐弹出 while Height<Tag do begin     Height := Height + 5;     Top := Top - 5;     Update;     Application.ProcessMessages;     Sleep(10);   end;   Height := Tag;   Tag := 0;   Color := $F4BA9D;   FormResize(Sender); end; procedure TfrmPSHotKey.FormPaint(Sender: TObject); var i: integer; rgn: HRGN; r: TRect; begin   with Canvas do begin       //利用imgTitleBarBG绘制标题背景 for i:=0 to ClientWidth div imgTitleBarBG.Width do       Draw(i*imgTitleBarBG.Width, 0, imgTitleBarBG.Picture.Bitmap);       if Tag<>0 then Exit; //如果窗体正在弹出状态，不绘制内容面板背景 //绘制内容面板背景 SetRect(r, 5, 15, Width-5, Height-5);       StretchDraw(r, imgShapeBG.Picture.Bitmap);       Pen.Color := $C97F55;       Brush.Style := bsClear;       RoundRect(r.Left, r.Top, r.Right, r.Bottom, 6, 6);       //绘制窗体边框 rgn := CreateRectRgn(0,0,0,0);       GetWindowRgn(Self.Handle, rgn);       Brush.Color := $BE796B;       windows.FrameRgn(Handle, rgn, Brush.Handle, 2, 2);       DeleteObject(rgn);     end;   end;      procedure TfrmPSHotKey.imgTitleBarMouseDown(Sender: TObject;   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);   begin     //在标题按下鼠标键时，允许移动窗体或改变窗体大小 ReleaseCapture;     if X < 5 then Perform(WM_SYSCOMMAND, $F004, 0)     else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F005, 0)     else if Y < 3 then Perform(WM_SYSCOMMAND, $F003, 0)     else Perform(WM_SYSCOMMAND, $F012, 0);   end;      procedure TfrmPSHotKey.FormResize(Sender: TObject);   var   rgn, rgn2: HRGN;   begin     if Tag<>0 then Exit;     //窗体改变大小时重建Rgn rgn := CreateRoundRectRgn(0, 0, Width+1, Height, 4, 4);     rgn2 := CreateRectRgn(0, 11, Width, Height);     CombineRgn(rgn, rgn, rgn2, RGN_OR);     SetWindowRgn(Handle, rgn, True);     DeleteObject(rgn);     DeleteObject(rgn2);     Invalidate;   end;      procedure TfrmPSHotKey.SpeedButton1Click(Sender: TObject);   begin     Close;   end;      //以下几个Label用来改变窗体大小 procedure TfrmPSHotKey.Label11MouseDown(Sender: TObject;   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);   begin     ReleaseCapture;     if X < 5 then Perform(WM_SYSCOMMAND, $F007, 0)     else if X > Width - 5 then Perform(WM_SYSCOMMAND, $F008, 0)     else Perform(WM_SYSCOMMAND, $F006, 0);   end;      procedure TfrmPSHotKey.Label12MouseDown(Sender: TObject;   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);   begin     ReleaseCapture;     Perform(WM_SYSCOMMAND, $F001, 0);   end;      procedure TfrmPSHotKey.Label13MouseDown(Sender: TObject;   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);   begin     ReleaseCapture;     Perform(WM_SYSCOMMAND, $F002, 0);   end;      //下面代码判断鼠标所在位置，并改变鼠标光标，提示用户可以拖动窗体或改变大小 procedure TfrmPSHotKey.imgTitleBarMouseMove(Sender: TObject;   Shift: TShiftState; X, Y: Integer);   begin     if X < 5 then imgTitleBar.Cursor := crSizeNWSE     else if X > Width - 5 then imgTitleBar.Cursor := crSizeNESW     else if Y < 3 then imgTitleBar.Cursor := crSizeNS     else imgTitleBar.Cursor := crSizeAll;   end;      procedure TfrmPSHotKey.Label11MouseMove(Sender: TObject;   Shift: TShiftState; X, Y: Integer);   begin     if X < 5 then Label11.Cursor := crSizeNESW     else if X > Width - 5 then Label11.Cursor := crSizeNWSE     else Label11.Cursor := crSizeNS;   end;    end.

转载于:https://www.cnblogs.com/wenwencao/archive/2010/05/18/1738320.html