VB程序启动后如何在通知区域显示

'语言:Micrisift Visual Basic 6.0
'功能:向系统托盘区添加图标
'作者:黄旭东
'日期:2004-10-22
'版权:CopyRight 2001-2005 By Faib Studio
'网址:http://faib.yeah.net
'邮件:faib920@163.com

Option Explicit

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function CallWindowProc Lib "user32" 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long

Private Const GWL_WNDPROC = (-4)
Private Const GWL_USERDATA = (-21)
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_INFO = &H10
Private Const NIIF_NONE = &H0
Private Const NIIF_WARNING = &H2
Private Const NIIF_ERROR = &H3
Private Const NIIF_INFO = &H1

Private Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uId As Long
    uFlags As Long
    uCallBackMessage As Long
    hIcon As Long
    szTip As String * 128
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256
    uTimeoutOrVersion As Long
    szInfoTitle As String * 64
    dwInfoFlags As Long
End Type

Public Enum EnumTrayEvent
    fbmNone = &H0
    fbmOnLButtonUp = &H1
    fbmOnRButtonUp = &H2
    fbmOnMButtonUp = &H4
    fbmOnLButtonDown = &H8
    fbmOnRButtonDown = &H10
    fbmOnMButtonDown = &H20
    fbmOnLButtonDbClick = &H40
    fbmOnRButtonDbClick = &H80
    fbmOnMButtonDbClick = &H100
    fbmOnAllClickEvents = &H1FF
End Enum
Public Enum EnumTrayMessage
    fbmMouseMove = &H200
    fbmLButtonDown = &H201
    fbmLButtonUp = &H202
    fbmLButtonDbClick = &H203
    fbmRButtonDown = &H204
    fbmRButtonUp = &H205
    fbmRButtonDbClick = &H206
    fbmMButtonDown = &H207
    fbmMButtonUp = &H208
    fbmMButtonDbClick = &H209
End Enum
Enum EnumTitleIcon
   fbiNone = 0
   fbiInfo = 1
   fbiWarning = 2
   fbiError = 3
End Enum

Dim sIcon As StdPicture
Dim sVis As Boolean
Dim sForm As Form
Dim sMenu As Menu
Dim shWnd As Long
Dim sTip As String
Dim sStyle As EnumTrayEvent
Dim nTray As NOTIFYICONDATA
Dim proWnd As Long
Dim mHook As Long
Dim mVis As Boolean

Public Property Let HookAddress(ByVal NewVal As Long)
'hook地址
mHook = NewVal
End Property

Public Property Get PopupStyle() As EnumTrayEvent
'返回/设置托盘菜单的动作模式
PopupStyle = sStyle
End Property

Public Property Let PopupStyle(NewVal As EnumTrayEvent)
sStyle = NewVal
End Property

Public Property Get Icon() As StdPicture
'图标
Set Icon = sIcon
End Property

Public Property Set Icon(NewVal As StdPicture)
    If sIcon Is Nothing Then
        Set sIcon = NewVal
    Else
        If Not NewVal Is sIcon Then Set sIcon = NewVal
    End If
    If Not sVis Then Exit Property '如果没有显示则退出,否则修改图标
    Modify "Icon"
End Property

Public Property Get TrayForm() As Form
'主窗体
Set TrayForm = sForm
End Property

Public Property Set TrayForm(NewVal As Form)
    If sForm Is Nothing Then
        Set sForm = NewVal
    Else
        If Not NewVal Is sForm Then Set sForm = NewVal
    End If
End Property

Public Property Get PopupMenu() As Menu
'弹出菜单
Set PopupMenu = sMenu
End Property

Public Property Set PopupMenu(NewVal As Menu)
    If sMenu Is Nothing Then
        Set sMenu = NewVal
    Else
        If Not sMenu Is sMenu Then Set sMenu = NewVal
    End If
End Property

Public Property Get TipText() As String
'提示信息
TipText = sTip
End Property

Public Property Let TipText(NewVal As String)
    sTip = NewVal
    If Not sVis Then Exit Property '如果没有显示则退出,否则修改提示信息
    Modify "Tip"
End Property

Public Property Get Visible() As Boolean
'是否显示
Visible = sVis
End Property

Public Property Let Visible(NewVal As Boolean)
    If NewVal = sVis Then Exit Property '如果设置相同则退出
    sVis = NewVal
    If NewVal Then Show Else Hide
End Property

Public Sub Show() '显示
    If mVis Then Exit Sub
    With nTray
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .cbSize = Len(nTray)
        .hWnd = sForm.hWnd
        .uId = vbNull
        .uCallBackMessage = fbmMouseMove
        .hIcon = sIcon.Handle
        .szTip = sTip & vbNullChar
    End With
    Shell_NotifyIcon NIM_ADD, nTray
    proWnd = SetWindowLong(sForm.hWnd, GWL_WNDPROC, AddressOf Wndproc)
    mVis = True: sVis = True
End Sub

Public Sub Hide() '移除
    If Not mVis Then Exit Sub
    SetWindowLong sForm.hWnd, GWL_WNDPROC, proWnd
    Shell_NotifyIcon NIM_DELETE, nTray
    mVis = False: sVis = False
End Sub

Public Sub ShowMessage(Title As String, Message As String, Optional TitleIcon As EnumTitleIcon = 0, Optional TimeOut As Long = 500)
    If Not sVis Then Exit Sub
    With nTray
        .uFlags = NIF_INFO Or NIF_MESSAGE
        .dwInfoFlags = NIIF_INFO
        .dwState = 0
        .hIcon = TitleIcon
        .dwStateMask = 0
        .szInfo = Message & vbNullChar
        .uTimeoutOrVersion = TimeOut
        .szInfoTitle = Title & vbNullChar
    End With
    Shell_NotifyIcon NIM_MODIFY, nTray
End Sub

Private Function Wndproc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    If Msg = fbmMouseMove Then
        Select Case lParam
        Case &H2
            Call Hide: Set sForm = Nothing: Set sIcon = Nothing
        Case fbmLButtonDbClick
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnLButtonDbClick) Then Popup
        Case fbmLButtonDown
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnLButtonDown) Then Popup
        Case fbmLButtonUp
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnLButtonUp) Then Popup
        Case fbmMButtonDbClick
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnMButtonDbClick) Then Popup
        Case fbmMButtonDown
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnMButtonDown) Then Popup
        Case fbmMButtonUp
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnMButtonUp) Then Popup
        Case fbmRButtonDbClick
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnRButtonDbClick) Then Popup
        Case fbmRButtonDown
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnRButtonDown) Then Popup
        Case fbmRButtonUp
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
            If sStyle <> fbmNone Then If CBool(sStyle And fbmOnRButtonUp) Then Popup
        Case fbmMouseMove
            If mHook <> 0 Then Wndproc = CallWindowProc(mHook, hWnd, lParam, wParam, lParam)
        End Select
    End If
    Wndproc = CallWindowProc(proWnd, hWnd, Msg, wParam, lParam)
End Function

Private Sub Modify(s As String)
    With nTray
        Select Case s
        Case "Icon"
            .hIcon = sIcon.Handle
            .uFlags = NIF_ICON
        Case "Tip"
            .uFlags = NIF_TIP
            .szTip = sTip & vbNullChar
        End Select
    End With
    Shell_NotifyIcon NIM_MODIFY, nTray
End Sub

Private Sub Popup()
'弹出菜单
SetForegroundWindow sForm.hWnd
sForm.PopupMenu sMenu
End Sub

VB程序启动后如何在通知区域显示相关推荐

python输入多个整数输入quit表示结束_代码实现程序启动后, 可以从键盘输入接收多个整数, 直到输入quit时结束输入. 把所有输入的整数倒序排列打印...
package com.loaderman.test; import java.util.Comparator; import java.util.Scanner; import java.util. ...
java程序启动后就进行了7次younggc_程序员如何优化 Java GC
本文由CrowHawk翻译 Sangmin Lee发表在Cubrid上的"Become a Java GC Expert"系列文章的第三篇<How to Tune Java ...
linux程序启动后查不到进程,Linux应用程序启动流程
工作了这么久, 现在也终于有时间来写写这几年在程序世界中的感受.一时之间并不知道从哪里开始.想来想去,还是从大学入学开始吧.记得那是一个风和日丽的下午,一堆大学生抱着书跑进教室,那个时候并没有那么多逃 ...
UITextField的属性与程序启动后一系列方法
// UITextField 文本输入框 // UITextField 继承与 UIControl // UIContr 继承与 UIView self.textField = [[UITextFie ...
计算机启动后需重启才能正常显示,电脑开机时屏幕显示无信号，需要重启后才能正常使用，是什么问题？...
第一次开机没显示器没显示,按理说不会有一声蜂鸣(嘀的一声),如果听到有蜂鸣声,说明主机自检通过.基本硬件没问题,肯定不是硬盘的问题.是显卡的问题(有这种情况,原因不明.),也可能是显示器显示延迟(不是 ...
udp程序启动后检测都是未启动_【例子教程】联想Leez P710 物联网AI物体检测
1 常见的物联网AI计算模式目前,物联网AI物体检测技术已经非常成熟了,它的计算模式只要有两种,一种是用云端来完成AI计算再把结果发回给终端,一种是直接在终端设备上做边缘计算. 终端上做边缘计算对设 ...
IP摄像机RTSP协议视频平台EasyNVR点击程序启动后闪退问题排查及解决
前段时间,TSINGSEE青犀视频的研发团队的技术支持在给客户进行EasyNVR排错,这位客户的报错主要是EasyNVR.exe程序无法进行启动并且启动就会闪退,虽然使用服务方式启动都显示正常,但是服 ...
一个java程序启动后至少有几个线程?他们的作用是什么?_java笔记录（三、多线程）...
1.进程和线程: 进程:正在进行的程序.每一个进程执行都有一个执行顺序,该顺序是一个执行路径,或者叫一个控制单元. 线程:进程内部的一条执行路径或者一个控制单元. 两者的区别: 一个进程至少有一个线程 ...
【java】程序启动后, 可以从键盘输入接收多个整数, 直到输入quit时结束输入. 把所有输入的整数倒序排列打印.
分析键盘输入创建TreeSet集合对象,TreeSet集合中传入比较器无限循环接受整数,直到遇到quit才退出判断是quit就退出,不是就将其转换为Integer,并添加到集合中遍历Tree ...
微信小程序发布后使用本地图片不显示问题
遇到安卓手机不显示本地图片的问题,不管是../../images/aaa.png路径还是相对根目录的路径 /images/aaa.png发布到线上后偶发图片不显示,经过多次尝试后终于解决,解决方法: ...

VB程序启动后如何在通知区域显示

VB程序启动后如何在通知区域显示相关推荐

最新文章

热门文章