分享
 
 
 

托盘图标提示

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

'窗体代码

'*************************************************************************

'**模 块 名:frmTest

'**说 明:YFsoft 版权所有2004 - 2005(C)

'**创 建 人:叶帆

'**日 期:2004-10-14 09:08:28

'**修 改 人:

'**日 期:

'**描 述:托盘气球提示

'**版 本:V1.0.0

'*************************************************************************

Option Explicit

'*************************************************************************

'**函 数 名:cmdDel_Click

'**输 入:无

'**输 出:无

'**功能描述:删除图标

'**全局变量:

'**调用模块:

'**作 者:叶帆

'**日 期:2004-10-14 09:34:58

'**修 改 人:

'**日 期:

'**版 本:V1.0.0

'*************************************************************************

Private Sub cmdDel_Click()

DelNotifyIcon Me

End Sub

'*************************************************************************

'**函 数 名:cmdShow_Click

'**输 入:无

'**输 出:无

'**功能描述:显示提示

'**全局变量:

'**调用模块:

'**作 者:叶帆

'**日 期:2004-10-14 09:34:44

'**修 改 人:

'**日 期:

'**版 本:V1.0.0

'*************************************************************************

Private Sub cmdShow_Click()

ShowNotifyIcon Me, txtTitle, txtInfo, cmbType.ListIndex

End Sub

'*************************************************************************

'**函 数 名:Form_Load

'**输 入:无

'**输 出:无

'**功能描述:

'**全局变量:

'**调用模块:初始化

'**作 者:叶帆

'**日 期:2004-10-14 09:08:57

'**修 改 人:

'**日 期:

'**版 本:V1.0.0

'*************************************************************************

Private Sub Form_Load()

cmbType.ListIndex = 1 '信息图标

cmdShow_Click '显示信息

End Sub

'*************************************************************************

'**函 数 名:Form_Unload

'**输 入:Cancel(Integer) -

'**输 出:无

'**功能描述:结束

'**全局变量:

'**调用模块:

'**作 者:叶帆

'**日 期:2004-10-14 09:35:32

'**修 改 人:

'**日 期:

'**版 本:V1.0.0

'*************************************************************************

Private Sub Form_Unload(Cancel As Integer)

'删除图标

cmdDel_Click

' 卸载所有窗体

Dim frm As Form

For Each frm In Forms

Unload frm

Next

End Sub

'模块代码

'*************************************************************************

'**模 块 名:mdlNotifyBase

'**说 明:YFsoft 版权所有2004 - 2005(C)

'**创 建 人:叶帆

'**日 期:2004-10-14 09:17:46

'**修 改 人:

'**日 期:

'**描 述:显示托盘提示模块

'**版 本:V1.0.0

'*************************************************************************

Option Explicit

Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_RBUTTONUP = &H205

Private Const WM_USER = &H400

Private Const WM_NOTIFYICON = WM_USER + 1 ' 自定义消息

Private Const WM_LBUTTONDBLCLK = &H203

Private Const GWL_WNDPROC = (-4)

' 关于气球提示的自定义消息, 2000下不产生这些消息

Private Const NIN_BALLOONSHOW = (WM_USER + &H2) ' 当 Balloon Tips 弹出时执行

Private Const NIN_BALLOONHIDE = (WM_USER + &H3) ' 当 Balloon Tips 消失时执行(如 SysTrayIcon 被删除),

' 但指定的 TimeOut 时间到或鼠标点击 Balloon Tips 后的消失不发送此消息

Private Const NIN_BALLOONTIMEOUT = (WM_USER + &H4) ' 当 Balloon Tips 的 TimeOut 时间到时执行

Private Const NIN_BALLOONUSERCLICK = (WM_USER + &H5) ' 当鼠标点击 Balloon Tips 时执行。

' 注意:在XP下执行时 Balloon Tips 上有个关闭按钮,

' 如果鼠标点在按钮上将接收到 NIN_BALLOONTIMEOUT 消息。

Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Type NOTIFYICONDATA

cbSize As Long ' 结构大小(字节)

hwnd As Long ' 处理消息的窗口的句柄

uId As Long ' 唯一的标识符

uFlags As Long ' Flags

uCallBackMessage As Long ' 处理消息的窗口接收的消息

hIcon As Long ' 托盘图标句柄

szTip As String * 128 ' Tooltip 提示文本

dwState As Long ' 托盘图标状态

dwStateMask As Long ' 状态掩码

szInfo As String * 256 ' 气球提示文本

uTimeoutOrVersion As Long ' 气球提示消失时间或版本

' uTimeout - 气球提示消失时间(单位:ms, 10000 -- 30000)

' uVersion - 版本(0 for V4, 3 for V5)

szInfoTitle As String * 64 ' 气球提示标题

dwInfoFlags As Long ' 气球提示图标

End Type

' dwState to NOTIFYICONDATA structure

Private Const NIS_HIDDEN = &H1 ' 隐藏图标

Private Const NIS_SHAREDICON = &H2 ' 共享图标

' dwInfoFlags to NOTIFIICONDATA structure

Private Const NIIF_NONE = &H0 ' 无图标

Private Const NIIF_INFO = &H1 ' "消息"图标

Private Const NIIF_WARNING = &H2 ' "警告"图标

Private Const NIIF_ERROR = &H3 ' "错误"图标

' uFlags to NOTIFYICONDATA structure

Private Const NIF_ICON As Long = &H2

Private Const NIF_INFO As Long = &H10

Private Const NIF_MESSAGE As Long = &H1

Private Const NIF_STATE As Long = &H8

Private Const NIF_TIP As Long = &H4

' dwMessage to Shell_NotifyIcon

Private Const NIM_ADD As Long = &H0

Private Const NIM_DELETE As Long = &H2

Private Const NIM_MODIFY As Long = &H1

Private Const NIM_SETFOCUS As Long = &H3

Private Const lngNIM_SETVERSION As Long = &H4

Private lngPreWndProc As Long

'*************************************************************************

'**函 数 名:ShowNotifyIcon

'**输 入:frm(Form) - 窗体

'** :strTitle(String) - 托盘提示标题

'** :strInfo(String) - 托盘提示信息

'** :Optional lngType(Long = 1) - 托盘提示类型 0 无 1 信息 2 警告 3 错误

'** :Optional lngTime(Long = 10000) - 停留时间

'**输 出:无

'**功能描述:显示托盘图标提示信息

'**全局变量:

'**调用模块:

'**作 者:叶帆

'**日 期:2004-10-14 09:23:14

'**修 改 人:

'**日 期:

'**版 本:V1.0.0

'*************************************************************************

Public Sub ShowNotifyIcon(frm As Form, strTitle As String, strInfo As String, Optional lngType As Long = 1, Optional lngTime As Long = 10000)

' 向托盘区添加图标

Dim IconData As NOTIFYICONDATA

strTitle = strTitle & vbNullChar

strInfo = strInfo & vbNullChar

With IconData

.cbSize = Len(IconData)

.hwnd = frm.hwnd

.uId = 0

.uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE Or NIF_INFO Or NIF_STATE

.uCallBackMessage = WM_NOTIFYICON

.szTip = strTitle

.hIcon = frm.Icon.Handle

.dwState = 0

.dwStateMask = 0

.szInfo = strInfo

.szInfoTitle = strTitle

.dwInfoFlags = lngType

.uTimeoutOrVersion = lngTime

End With

If lngPreWndProc = 0 Then '没有初始化

Shell_NotifyIcon NIM_ADD, IconData

lngPreWndProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf WindowProc)

Else '已初始化

Shell_NotifyIcon NIM_MODIFY, IconData

End If

End Sub

'*************************************************************************

'**函 数 名:DelNotifyIcon

'**输 入:frm(Form) - 窗体

'**输 出:无

'**功能描述:删除托盘图标

'**全局变量:

'**调用模块:

'**作 者:叶帆

'**日 期:2004-10-14 09:33:01

'**修 改 人:

'**日 期:

'**版 本:V1.0.0

'*************************************************************************

Public Sub DelNotifyIcon(frm As Form)

If lngPreWndProc <> 0 Then

' 删除托盘区图标

Dim IconData As NOTIFYICONDATA

With IconData

.cbSize = Len(IconData)

.hwnd = frm.hwnd

.uId = 0

.uFlags = NIF_TIP Or NIF_ICON Or NIF_MESSAGE

.uCallBackMessage = WM_NOTIFYICON

.szTip = ""

.hIcon = frm.Icon.Handle

End With

Shell_NotifyIcon NIM_DELETE, IconData

SetWindowLong frm.hwnd, GWL_WNDPROC, lngPreWndProc

lngPreWndProc = 0

End If

End Sub

'*************************************************************************

'**函 数 名:WindowProc

'**输 入:ByVal hwnd(Long) -

'** :ByVal msg(Long) -

'** :ByVal wParam(Long) -

'** :ByVal lParam(Long) -

'**输 出:(Long) -

'**功能描述:frmTest 窗口入口函数

'**全局变量:

'**调用模块:

'**作 者:叶帆

'**日 期:2004-10-14 09:19:06

'**修 改 人:

'**日 期:

'**版 本:V1.0.0

'*************************************************************************

Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

' 拦截 WM_NOTIFYICON 消息

If msg = WM_NOTIFYICON Then

Select Case lParam

Case WM_RBUTTONUP

' 右键单击图标是运行这里的代码, 可以在这里添加弹出右键菜单的代码

Case WM_LBUTTONDBLCLK

' 左键单击 显示窗体

frmTest.Show

Case NIN_BALLOONSHOW

Debug.Print "显示气球提示"

Case NIN_BALLOONHIDE

Debug.Print "删除托盘图标"

Case NIN_BALLOONTIMEOUT

Debug.Print "气球提示消失"

Case NIN_BALLOONUSERCLICK

Debug.Print "单击气球提示"

End Select

End If

WindowProc = CallWindowProc(lngPreWndProc, hwnd, msg, wParam, lParam)

End Function

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
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- 王朝網路 版權所有