就是可以很好支持菜单显示的很稳定的那种,这里贴的很多代码都调试不过去,谢谢!

解决方案 »

  1.   

    模块中:
    Option ExplicitPrivate Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Const GWL_WNDPROC As Long = -4
    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 LongPrivate OldProc As LongPublic Sub SubClassIt(ByVal hWnd As Long)
        If OldProc Then Exit Sub
        
        OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
        
    End SubPublic Sub UnSubClass(ByVal hWnd As Long)
        If OldProc = 0 Then Exit Sub
        
    End SubPrivate Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        WndProc = Form1.WndProc(hWnd, uMsg, wParam, lParam)
    End FunctionPublic Function CallNextMsg(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        CallNextMsg = CallWindowProc(OldProc, hWnd, uMsg, wParam, lParam)
    End Function窗体中:
    Option Explicit#Const WIN32_IE = &H600 'WinXP
    Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
    Private Const NIM_ADD As Long = &H0
    Private Const NIM_MODIFY As Long = &H1
    Private Const NIM_DELETE As Long = &H2
    Private Const NIM_SETFOCUS As Long = &H3
    Private Const NIM_SETVERSION As Long = &H4Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End TypePrivate Const NOTIFYICONDATA_V1_SIZE As Long = 88
    #If WIN32_IE < &H600 Then
    Private Const NOTIFYICONDATA_V2_SIZE As Long = 488
    #Else
    Private Const NOTIFYICONDATA_V2_SIZE As Long = 504
    #End If
    Private Type NOTIFYICONDATA
        cbSize As Long
        hWnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        #If WIN32_IE < &H500 Then
            szTip As String * 64
        #Else
            szTip As String * 128
        #End If
        #If WIN32_IE >= &H500 Then
            dwState As Long
            dwStateMask As Long
            szInfo As String * 256
            uTimeout As Long
            szInfoTitle As String * 64
            dwInfoFlags As Long
        #End If
        #If WIN32_IE >= &H600 Then
            guidItem As GUID
        #End If
    End Type
    Private Const NIF_MESSAGE As Long = &H1
    Private Const NIF_ICON As Long = &H2
    Private Const NIF_TIP As Long = &H4
    Private Const NIF_STATE As Long = &H8
    Private Const NIF_INFO As Long = &H10
    #If WIN32_IE >= &H600 Then
    Private Const NIF_GUID As Long = &H20
    #End IfPrivate Const NIS_HIDDEN As Long = &H1
    Private Const NIS_SHAREDICON As Long = &H2Private Const NOTIFYICON_VERSION As Long = 3Private Const NIIF_NONE As Long = &H0
    Private Const NIIF_INFO As Long = &H1
    Private Const NIIF_WARNING As Long = &H2
    Private Const NIIF_ERROR As Long = &H3
    Private Const NIIF_ICON_MASK As Long = &HF
    Private Const NIIF_NOSOUND As Long = &H10
    Private Const WM_USER As Long = &H400
    Private Const NIN_GETVERSION As Long = (WM_USER + 0)
    Private Const NIN_SELECT As Long = (WM_USER + &H2)
    Private Const NINF_KEY As Long = &H1
    Private Const NIN_KEYSELECT As Long = (NIN_SELECT Or NINF_KEY)
    #If WIN32_IE >= &H501 Then
    Private Const NIN_BALLOONSHOW = WM_USER + 2
    Private Const NIN_BALLOONHIDE = WM_USER + 3
    Private Const NIN_BALLOONTIMEOUT = WM_USER + 4
    Private Const NIN_BALLOONUSERCLICK = WM_USER + 5
    #End If
    Private Const WM_MOUSEMOVE = &H200
    Private Const WM_LBUTTONDOWN = &H201
    Private Const WM_LBUTTONUP = &H202
    Private Const WM_LBUTTONDBLCLK = &H203
    Private Const WM_RBUTTONDOWN = &H204
    Private Const WM_RBUTTONUP = &H205
    Private Const WM_RBUTTONDBLCLK = &H206
    Private Const WM_MBUTTONDOWN = &H207
    Private Const WM_MBUTTONUP = &H208
    Private Const WM_MBUTTONDBLCLK = &H209'##########################################################
    Private Declare Function RegisterWindowMessage Lib "user32.dll" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
    Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As LongPrivate Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Const WM_GETICON As Long = &H7F
    Private Const ICON_SMALL As Long = 0Const WM_MySysTray = WM_USER + &H100
    Private WM_TaskbarCreated As LongConst MySysTrayID As Long = 0Private Sub ChkShow_Click()
        Dim nid As NOTIFYICONDATA
        nid.cbSize = NOTIFYICONDATA_V2_SIZE
        nid.hWnd = Me.hWnd
        nid.uID = MySysTrayID
        nid.uFlags = NIF_STATE
        nid.dwState = (ChkShow.Value = 0) And NIS_HIDDEN
        nid.dwStateMask = NIS_HIDDEN
        Shell_NotifyIcon NIM_MODIFY, nid
    End SubPrivate Sub CmdSet_Click()
        Dim nid As NOTIFYICONDATA
        nid.cbSize = NOTIFYICONDATA_V2_SIZE
        nid.hWnd = Me.hWnd
        nid.uID = MySysTrayID
        nid.uFlags = NIF_INFO
        nid.szInfoTitle = TxtTitle.Text & vbNullChar
        nid.szInfo = TxtInfo.Text & vbNullChar
        nid.uTimeout = Val(TxtTimeOut.Text)
        nid.dwInfoFlags = (CboIcon.ListIndex And NIIF_ICON_MASK) Or ((ChkNoSound.Value <> 0) And NIIF_NOSOUND)
        Shell_NotifyIcon NIM_MODIFY, nid
    End SubPrivate Sub Form_Initialize()
        Debug.Print
        Debug.Print String(60, "=")
    End SubPrivate Sub Form_Load()
        'Dim nid As NOTIFYICONDATA
        'Debug.Print Len(nid)
        
        CboIcon.ListIndex = 1
        
        WM_TaskbarCreated = RegisterWindowMessage("TaskbarCreated")
        Module1.SubClassIt Me.hWnd
        SysTrayAdd
        CmdSet_Click
        
    End SubPrivate Sub Form_Resize()
        If Me.WindowState = vbMinimized Then
            Me.Hide
        End If
    End SubPrivate Sub Form_Unload(Cancel As Integer)
        Module1.UnSubClass Me.hWnd
        SysTrayDel
        
    End SubPrivate Sub ShowMsg(szMsg As String)
        Debug.Print szMsg
    End SubPrivate Sub SysTrayAdd()
        Dim nid As NOTIFYICONDATA
        nid.cbSize = NOTIFYICONDATA_V2_SIZE
        nid.hWnd = Me.hWnd
        nid.uID = MySysTrayID
        nid.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
        nid.uCallbackMessage = WM_MySysTray
        nid.hIcon = SendMessage(Me.hWnd, WM_GETICON, ICON_SMALL, ByVal 0&)
        nid.szTip = Me.Caption & vbNullChar
        Shell_NotifyIcon NIM_ADD, nid
    End SubPrivate Sub SysTrayDel()
        Dim nid As NOTIFYICONDATA
        nid.cbSize = NOTIFYICONDATA_V2_SIZE
        nid.hWnd = Me.hWnd
        nid.uID = MySysTrayID
        Shell_NotifyIcon NIM_DELETE, nid
    End SubPrivate Sub mnuExit_Click()
        Unload Me
    End SubPrivate Sub mnuShow_Click()
        If Me.WindowState = vbMinimized Then Me.WindowState = vbNormal
        Me.SetFocus
    End SubPublic Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
        'Debug.Print "uMsg:" & uMsg
        
        Select Case uMsg
        Case WM_MySysTray
            If wParam = MySysTrayID Then
                'ShowMsg "WM_MySysTray: &H" & Hex(lParam)
                Select Case lParam
                Case WM_RBUTTONUP
                    'SetForegroundWindow Me.hWnd
                    Me.SetFocus
                    PopupMenu mnuPop, vbPopupMenuRightButton
                    
                Case NIN_BALLOONSHOW
                    ShowMsg "NIN_BALLOONSHOW"
                    
                Case NIN_BALLOONHIDE
                    ShowMsg "NIN_BALLOONHIDE"
                    
                Case NIN_BALLOONTIMEOUT
                    ShowMsg "NIN_BALLOONTIMEOUT"
                    
                Case NIN_BALLOONUSERCLICK
                    ShowMsg "NIN_BALLOONUSERCLICK"
                    
                End Select
            End If
            
        Case WM_TaskbarCreated
            ShowMsg "TaskbarCreated"
            SysTrayAdd
            
        Case Else
            WndProc = CallNextMsg(hWnd, uMsg, wParam, lParam)
            
        End Select
        
    End Function我就是用的这个,无问题。
      

  2.   

    Option Explicit
    '  API 函数声明
    Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
    '  字符常数说明
        Private Const NIM_ADD = &H0
        Private Const NIM_DELETE = &H2
        Private Const NIF_ICON = &H2
        Private Const NIF_TIP = &H4
    '  定义结构型变量
    Private Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uId As Long
        uFlags As Long
        ucallbackMessage As Long
        hIcon As Long
        szTip As String * 64
    End Type
    '  说明 TrayIcon 是结构型变量
    Private TrayIcon As NOTIFYICONDATA
    Private Sub Form_load()
    '  窗体装入,设置图标及图标显示形式
        TrayIcon.cbSize = Len(TrayIcon)
        TrayIcon.hwnd = Me.hwnd
        TrayIcon.uFlags = NIF_ICON Or NIF_TIP
        TrayIcon.hIcon = Image1.Picture
        TrayIcon.szTip = "Icon" & vbNullChar
    End Sub
    Private Sub Command1_Click()
    '  在Windows任务栏中加入图标
       Shell_NotifyIcon NIM_ADD, TrayIcon
    End Sub
      

  3.   

    http://www.csdn.net/cnshare/soft/16/16015.shtm
      

  4.   


    Private Type NOTIFYICONDATA
        cbSize As Long
        hWnd As Long
        uId As Long
        uFlags As Long
        ucallbackMessage As Long
        hIcon As Long
        szTip As String * 64
    End TypePrivate 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 = &H4Private Const WM_LBUTTONDBLCLK = &H203
    Private Const WM_LBUTTONDOWN = &H201
    Private Const WM_RBUTTONUP = &H205Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
    Dim TrayI As NOTIFYICONDATA
    Private Sub Form_Load()
        TrayI.cbSize = Len(TrayI)
        'Set the window's handle (this will be used to hook the specified window)
        TrayI.hWnd = pichook.hWnd
        'Application-defined identifier of the taskbar icon
        TrayI.uId = 1&
        'Set the flags
        TrayI.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        'Set the callback message
        TrayI.ucallbackMessage = WM_LBUTTONDOWN
        'Set the picture (must be an icon!)
        TrayI.hIcon = imgIcon(2).Picture
        'Set the tooltiptext
        TrayI.szTip = "Recent" & Chr$(0)
        'Create the icon
        Shell_NotifyIcon NIM_ADD, TrayI    Me.Hide
    End Sub
    Private Sub Form_Unload(Cancel As Integer)
        'remove the icon
        TrayI.cbSize = Len(TrayI)
        TrayI.hWnd = pichook.hWnd
        TrayI.uId = 1&
        Shell_NotifyIcon NIM_DELETE, TrayI
        End
    End Sub
    Private Sub mnuPop_Click(Index As Integer)
        Select Case Index
            Case 0
                MsgBox "KPD-Team 1998" + Chr$(13) + "URL: http://www.allapi.net/" + Chr$(13) + "E-Mail: [email protected]", vbInformation + vbOKOnly
            Case 2
                Unload Me
        End Select
    End Sub
    Private Sub pichook_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Msg = X / Screen.TwipsPerPixelX
        If Msg = WM_LBUTTONDBLCLK Then
            'Left button double click
            mnuPop_Click 0
        ElseIf Msg = WM_RBUTTONUP Then
            'Right button click
            Me.PopupMenu mnuPopUp
        End If
    End Sub
    Private Sub Timer1_Timer()
        Static Tek As Integer
        'Animate the icon
        Me.Icon = imgIcon(Tek).Picture
        TrayI.hIcon = imgIcon(Tek).Picture
        Tek = Tek + 1
        If Tek = 3 Then Tek = 0
        Shell_NotifyIcon NIM_MODIFY, TrayI
    End Sub
      

  5.   

    这方面的代码在CSDN可以找到N个出来
      

  6.   

    呵呵,,,比我早了这么多呀???呵呵,,我有源程序,要的话,给我来信[email protected]
      

  7.   

    我想要
    [email protected]
    谢谢!它稳定吗?对于Explorer的异常错误,系统栏图标消失,有好的解决方法吗?
    (不会是用定时器吧,好象错误时会发送一个消息,那只要拦截这个消息,再重绘图标就可)
      

  8.   

    谢谢以上几位。
    请问还有可以修改图标的么?以及开发过程中就能非常稳定的。以上intersun(毫无意义的名字)的代码在开发过程中如果出现错误就会立刻退出IDE
      

  9.   

    顶啊!搜索网上的代码都非常不稳定,几乎没有使用的价值!单独操作一个托盘或许还可以,但是附加上其他的功能代码以后,动不动就退出。intersun朋友的相对比较稳定,但是不能任意修改托盘图标。
      

  10.   

    intersun朋友,你的方法为什么每次运行的时候tooltip弹出的特别慢,而第二次运行就立刻出来。
      

  11.   

    修改托盘图标可以啊,使用Shell_NotifyIcon NIM_MODIFY, nid就可以,nid.hIcon赋予一个图片对象。
    每次运行的时候tooltip弹出的特别慢,而第二次运行就立刻出来——这个现象没有发现,我这里挺快的啊......
      

  12.   

    请问intersun朋友,消息WM_TaskbarCreated有什么用,是怎么用的,什么情况下会触发这个消息
      

  13.   

    如果你VB安装盘的话,
    在TOOL目录有微软的源代码。