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

Question

急呀，
“VB程序启动后如何象QQ那样在通知区域显示”

Answer 1

'语言:Micrisift Visual Basic 6.0
'功能:向系统托盘区添加图标
'作者:黄旭东
'日期:2004-10-22
'版权:CopyRight 2001-2005 By Faib Studio
'网址:http://faib.yeah.net
'邮件:[email protected] ExplicitPrivate 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 LongPrivate 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 = &H1Private 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 TypePublic 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 EnumDim 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 BooleanPublic Property Let HookAddress(ByVal NewVal As Long)
'hook地址
    mHook = NewVal
End PropertyPublic Property Get PopupStyle() As EnumTrayEvent
'返回/设置托盘菜单的动作模式
    PopupStyle = sStyle
End PropertyPublic Property Let PopupStyle(NewVal As EnumTrayEvent)
    sStyle = NewVal
End PropertyPublic Property Get Icon() As StdPicture
'图标
    Set Icon = sIcon
End PropertyPublic 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 PropertyPublic Property Get TrayForm() As Form
'主窗体
    Set TrayForm = sForm
End PropertyPublic 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 PropertyPublic Property Get PopupMenu() As Menu
'弹出菜单
    Set PopupMenu = sMenu
End Property

Answer 2

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 PropertyPublic Property Get TipText() As String
'提示信息
    TipText = sTip
End PropertyPublic Property Let TipText(NewVal As String)
    sTip = NewVal
    If Not sVis Then Exit Property '如果没有显示则退出,否则修改提示信息
    Modify "Tip"
End PropertyPublic Property Get Visible() As Boolean
'是否显示
    Visible = sVis
End PropertyPublic Property Let Visible(NewVal As Boolean)
    If NewVal = sVis Then Exit Property '如果设置相同则退出
    sVis = NewVal
    If NewVal Then Show Else Hide
End PropertyPublic 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 SubPublic Sub Hide() '移除
    If Not mVis Then Exit Sub
    SetWindowLong sForm.hWnd, GWL_WNDPROC, proWnd
    Shell_NotifyIcon NIM_DELETE, nTray
    mVis = False: sVis = False
End SubPublic 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 SubPrivate 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 FunctionPrivate 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 SubPrivate Sub Popup()
'弹出菜单
    SetForegroundWindow sForm.hWnd
    sForm.PopupMenu sMenu
End Sub

Answer 3

添加一个模块.
这是模块代码:Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias _
     "Shell_NotifyIconA" (ByVal dwMessage As Long, _
     lpData As NOTIFYICONDATA) As LongPublic 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 Const NOTIFYICON_VERSION = 3
Public Const NOTIFYICON_OLDVERSION = 0Public Const NIM_ADD = &H0
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2Public Const NIM_SETFOCUS = &H3
Public Const NIM_SETVERSION = &H4
 
Public Const NIF_MESSAGE = &H1
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
 
Public Const NIS_HIDDEN = &H1
Public Const NIS_SHAREDICON = &H2
 Public Const NIIF_NONE = &H0
Public Const NIIF_WARNING = &H2
Public Const NIIF_ERROR = &H3
Public Const NIIF_INFO = &H1Public nfIconData As NOTIFYICONDATA'这是窗口代码Private Sub Form_Load()
    With nfIconData
        .cbSize = Len(nfIconData)
        .hwnd = Me.hwnd
        .uId = vbNull
        .uFlags = NIF_INFO Or NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .hIcon = Me.Icon
        .szTip = "这是小消息..." & vbNullChar
        .dwState = 0
        .dwStateMask = 0
        .szInfo = "这是一个Balloon Style Tool-tip！" & Chr(13) & "：）" & vbNullChar
        .uTimeoutOrVersion = 15000
        .szInfoTitle = "yes" & vbNullChar
        .dwInfoFlags = NIIF_INFO
    End With     Call Shell_NotifyIcon(NIM_ADD, nfIconData)
End Sub
Private Sub Form_Unload(Cancel As Integer)
     Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Answer 4

http://community.csdn.net/Expert/topic/3454/3454471.xml?temp=.4036676