分享
 
 
 

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

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

微软的每一个产品,无论功能还是界面设计都会带给我们一定的惊喜,比如OfficeXP、Office2003、Messenger的界面设计,早已成为众多软件竞相模仿的对象,就拿Messenger来说,我就见过好几套网络视频会议的软件都借鉴了它的界面风格。

前段时间因为要在原来的软件上增加一个快捷键提示窗体,这个提示窗要求在显示的时候比较醒目美观能引起用户注意,显示后不影响用户操作,能够关掉。很自然的就想到了Messenger那个从屏幕右下角逐渐弹出的消息提示窗体,不过相对Messenger我更喜欢QQ2004奥运版的配色风格,反正都是偷就多偷点吧,下面快捷键提示窗的最终效果:

这个窗体有以下几个特点:

1、显示的时候是从屏幕右下角逐渐弹出的;

2、它是个无标题窗体,但它必须允许用户移动和改变大小,因此要用到无标题窗体拖动、改变大小的技术;

3、它是个不规则的窗体,主要是左上角和右上角是圆形导角,因此要为窗体创建外形,且窗体改变大小时必须重建;

4、它标题和内容显示区都有渐层色,标题还有几个小点点,在实现时使用取巧的方法,直接利用截图进行填充。

当然界面可以偷,代码就得老老实实的写的了,下面是界面设计图和实现代码:

界面formPSHotKey.frm内容[内容较长,请点击此处找开/折叠]

object frmPSHotKey: TfrmPSHotKey

Left = 192

Top = 107

BorderStyle = bsNone

Caption = '快捷键提示'

ClientHeight = 168

ClientWidth = 343

Color = clWhite

Constraints.MinWidth = 350

Font.Charset = GB2312_CHARSET

Font.Color = clWindowText

Font.Height = -12

Font.Name = '宋体'

Font.Style = []

FormStyle = fsStayOnTop

OldCreateOrder = False

OnCreate = FormCreate

OnPaint = FormPaint

OnResize = FormResize

DesignSize = (

343

168)

PixelsPerInch = 96

TextHeight = 12

object imgTitleBar: TImage

Left = 0

Top = 0

Width = 343

Height = 12

Cursor = crSizeAll

Align = alTop

AutoSize = True

Center = True

Picture.Data = {

07544269746D6170EE010000424DEE010000000000006E000000280000003900

00000C000000010004000000000080010000120B0000120B00000E0000000E00

0000D79D8B00A83A1700F8E6D600C9775E00F6DFCB00FAEDE200F4D7BE00F5DA

C200EAD2BF00FCF5EE00FEFBF800BE796B00FFFFFF0000000000BBBBBBBBBBBB

BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB000D0D0888888888888

888888888888888888888888888888888888888888888000BBBB666666666666

6666666666666666666666666666666666666666666660008888777777777777

777777777777777777777777777777777777777777777000666644CC44CC44CC

44CC44CC44CC44CC44CC44CC44CC44CC44CC44CC44CC40007777231C231C231C

231C231C231C231C231C231C231C231C231C231C231C200044CC503550355035

503550355035503550355035503550355035503550355000231C999999999999

9999999999999999999999999999999999999999999990005035AAAAAAAAAAAA

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA0009999CCCCCCCCCCCC

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC000AAAABBBBBBBBBBBB

BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB000CCCCBBBBBBBBBBBB

BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB000BBBB}

OnMouseDown = imgTitleBarMouseDown

OnMouseMove = imgTitleBarMouseMove

end

object imgTitleBarBG: TImage

Left = 248

Top = 32

Width = 7

Height = 12

AutoSize = True

Picture.Data = {

07544269746D617092000000424D920000000000000062000000280000000700

00000C000000010004000000000030000000120B0000120B00000B0000000B00

0000F4D7BE00F8E6D600F6DFCB00F5DAC200EAD2BF00FCF5EE00FEFBF800FAED

E200BE796B00FFFFFF0000000000888888804444444000000000333333302222

222011111110777777705555555066666660999999908888888088888880}

Visible = False

end

object imgShapeBG: TImage

Left = 280

Top = 48

Width = 3

Height = 56

AutoSize = True

Picture.Data = {

07544269746D6170DA010000424DDA01000000000000FA000000280000000300

0000380000000100080000000000E0000000120B0000120B0000310000003100

000000000000FFFFFF00FFFCFC00FFFDFD00FFF9F800FFFAF900FFFBFA00FFF6

F300FFF7F400FFF9F700FFFCFB00FFF0EA00FFF3EE00FFF5F100FFFAF800FFE5

D900FFE7DC00FFE9DF00FFEBE200FFEDE500FFEEE600FFEFE800FFF0E900FFF2

EC00FFF4EF00FFF6F200FFF8F500FFE5D800FFE6D900FFE6DA00FFE7DB00FFE8

DC00FFE8DD00FFE9DE00FFEAE000FFEBE100FFECE300FFEDE400FFEFE700FFF1

EA00FFF3ED00FFF5F000FFF7F300FFF9F600FFFBF900FFFDFC00FFE9DD00FFEC

E200FFF2EB001B1B1B000F0F0F001C1C1C001D1D1D001D1D1D001E1E1E001E1E

1E00101010001F1F1F00202020002E2E2E002121210011111100222222002222

220023232300121212002F2F2F00242424002525250013131300141414001414

14002626260015151500161616000B0B0B002727270030303000171717002828

28000C0C0C001818180018181800292929000D0D0D0019191900070707002A2A

2A00080808001A1A1A001A1A1A002B2B2B0009090900040404000E0E0E000505

05002C2C2C0006060600060606000A0A0A000A0A0A00020202002D2D2D000303

030003030300}

Visible = False

end

object SpeedButton1: TSpeedButton

Left = 323

Top = 16

Width = 14

Height = 14

Anchors = [akTop, akRight]

Flat = True

Glyph.Data = {

8A000000424D8A00000000000000420000002800000009000000090000000100

04000000000048000000120B0000120B00000300000003000000BE604200FFFF

FF00000000001111111110000200100111001000111110001000100010011100

0001100010001110001110001100110000011000111010001000100011001001

1100100010001111111110001001}

OnClick = SpeedButton1Click

end

object Label1: TLabel

Left = 16

Top = 24

Width = 60

Height = 12

Caption = '快捷键提示'

Font.Charset = GB2312_CHARSET

Font.Color = clWindowText

Font.Height = -12

Font.Name = '宋体'

Font.Style = []

ParentFont = False

Transparent = True

end

object Label2: TLabel

Left = 16

Top = 99

Width = 294

Height = 12

Caption = 'A:光标在“编号”列时,切换数据类型为“步骤类型”'

Transparent = True

end

object Label3: TLabel

Left = 16

Top = 118

Width = 318

Height = 12

Caption = 'B:光标在“编号”列时,切换数据类型为“工艺要求类型”'

Transparent = True

end

object Label4: TLabel

Left = 16

Top = 138

Width = 294

Height = 12

Caption = 'C:光标在“编号”列时,切换数据类型为“用料类型”'

Transparent = True

end

object Label5: TLabel

Left = 16

Top = 42

Width = 132

Height = 12

Caption = 'Alt+↓:打开下拉列表框'

Transparent = True

end

object Label6: TLabel

Left = 16

Top = 61

Width = 108

Height = 12

Caption = 'Ctrl+Ins:插入一行'

Transparent = True

end

object Label7: TLabel

Left = 16

Top = 80

Width = 120

Height = 12

Caption = 'Ctrl+Del:删除当前行'

Transparent = True

end

object Label8: TLabel

Left = 174

Top = 42

Width = 138

Height = 12

Caption = 'Ins:打开“工艺名称表”'

Transparent = True

end

object Label9: TLabel

Left = 174

Top = 61

Width = 90

Height = 12

Caption = 'F11:插入“℃”'

Transparent = True

end

object Label10: TLabel

Left = 174

Top = 80

Width = 90

Height = 12

Caption = 'F12:插入“′”'

Transparent = True

end

object Label11: TLabel

Left = 0

Top = 165

Width = 343

Height = 3

Cursor = crSizeNS

Align = alBottom

AutoSize = False

Transparent = True

OnMouseDown = Label11MouseDown

OnMouseMove = Label11MouseMove

end

object Label12: TLabel

Left = 0

Top = 12

Width = 3

Height = 153

Cursor = crSizeWE

Align = alLeft

AutoSize = False

Transparent = True

OnMouseDown = Label12MouseDown

end

object Label13: TLabel

Left = 340

Top = 12

Width = 3

Height = 153

Cursor = crSizeWE

Align = alRight

AutoSize = False

Transparent = True

OnMouseDown = Label13MouseDown

end

end

代码formPSHotKey.pas内容

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.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有