???托盘???

Question

我的程序添加了托盘图标部分的代码后，在vb的调试环境中只能按结束按钮结束程序，否则就会连同程序和vb一起关掉！我用的代码论坛上都有人贴过了，大家一看就知道了，虽然可以正常用，但是实在是太麻烦了！我翻了翻原来的帖子，没有提到这种情况的，请大家帮我一把。Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As MenuDeclare 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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2Public 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 TheData As NOTIFYICONDATA
' *********************************************
' The replacement window proc.
' *********************************************
Public Function NewWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
    If Msg = TRAY_CALLBACK Then
        ' The user clicked on the tray icon.
        ' Look for click events.
        If lParam = WM_LBUTTONUP Then
            ' On left click, show the form.
            TheForm.SetFocus
            Exit Function
        End If
        If lParam = WM_RBUTTONUP Then
            ' On right click, show the menu.
            TheForm.PopupMenu TheMenu
            Exit Function
        End If
    End If
    
    ' Send other messages to the original
    ' window proc.
'这里的问题！可是源代码单独用没有问题，就是放在我的程序中不行     NewWindowProc = CallWindowProc( _
        OldWindowProc, hwnd, Msg, _
        wParam, lParam)
End Function
' *********************************************
' Add the form's icon to the tray.
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
    ' ShowInTaskbar must be set to False at
    ' design time because it is read-only at
    ' run time.    ' Save the form and menu for later use.
    Set TheForm = frm
    Set TheMenu = mnu
    
    ' Install the new WindowProc.
'这里的问题！可是源代码单独用没有问题，就是放在我的程序中不行     
OldWindowProc = SetWindowLong(frm.hwnd, _
        GWL_WNDPROC, AddressOf NewWindowProc)
    
    ' Install the form's icon in the tray.
    With TheData
        .uID = 0
        .hwnd = frm.hwnd
        .cbSize = Len(TheData)
        .hIcon = frm.Icon.Handle
        .uFlags = NIF_ICON
        .uCallbackMessage = TRAY_CALLBACK
        .uFlags = .uFlags Or NIF_MESSAGE
        .cbSize = Len(TheData)
    End With
    Shell_NotifyIcon NIM_ADD, TheData
End Sub
' *********************************************
' Remove the icon from the system tray.
' *********************************************
Public Sub RemoveFromTray()
    ' Remove the icon from the tray.
    With TheData
        .uFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData
    
    ' Restore the original window proc.
    SetWindowLong TheForm.hwnd, GWL_WNDPROC, _
        OldWindowProc
End Sub
' *********************************************
' Set a new tray tip.
' *********************************************
Public Sub SetTrayTip(tip As String)
    With TheData
        .szTip = tip & vbNullChar
        .uFlags = NIF_TIP
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
' *********************************************
' Set a new tray icon.
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
    ' Do nothing if the picture is not an icon.
    If pic.Type <> vbPicTypeIcon Then Exit Sub    ' Update the tray icon.
    With TheData
        .hIcon = pic.Handle
        .uFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub让图标接受信息只能用他这个么？有没有别的方法（不过我觉得他的不错，就是在我的程序上不行）

Answer 1

http://expert.csdn.net/Expert/topic/2082/2082509.xml?temp=.1619074
http://www.fantasiasoft.net/Zyl910/ZSubClass.zip
项目名：zSubClass
作者：zyl910功能：专门用来处理SubClass操作特点：
1.同一个ISubClass类能同时检测多个窗口的消息
2.使用计数访问技术，所以对同一个窗口进行多次SubClass也不会出错
3.自定义了一个ZM_UnSubClass外部消息，彻底解决取消SubClass时的顺序问题
4.允许以 接口函数、事件 两种方法接受消息
5.允许设定接受级别（能让自己的类最先或最后得到消息），这样有助于处理通知消息
6.由于封装成了ActiveX DLL，所以可以在调试环境下随意中断
7.有MsgIn、MsgOut两个接口，你可以选择在下级处理程序处理 之前 或 之后 处理消息
与vbaccelerator.com的SubClass DLL的区别：
1.它只支持接口方式，不支持事件，在某些时候有点不方便
2.它是用窗口属性函数保存信息的。窗口属性函数涉及到字符串，而字符串传递、查找是最花时间的，所以降低了效率。而我呢，专门将他们的hWnd保存在一个排好序的数组，再用二分法查找，效率高多了
3.用窗口属性函数还有一个缺点，就是它的信息可以被外部程序得到。万一外部程序不小心（或是故意的）修改的话，立即非法操作。我的程序是完全隐藏，安全性极佳
4.它是以消息为单位处理的，我是以窗口为单位处理的。对于需要拦截某个窗口的多个消息时，我的更方便
5.它不支持级别设置，这样对于处理通知消息很不方便

Answer 2

6.由于封装成了ActiveX DLL，所以可以在调试环境下随意中断

Answer 3

'-------------------------------------------------------------------
'类模块:托盘图标的添加
'-------------------------------------------------------------------Option ExplicitPrivate Declare Function Shell_NotifyIcon Lib "shell32" Alias _
    "Shell_NotifyIconA" (ByVal dwMessage As Long, _
    pNid As NOTIFYICONDATA) As BooleanPrivate Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4Private 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 = &H206Private Type NOTIFYICONDATA
    lSize As Long
    hWnd As Long
    lId As Long
    lFlags As Long
    lCallBackMessage As Long
    hIcon As Long
    szTip As String * 64
End TypePrivate mNID As NOTIFYICONDATA
Private WithEvents mPic As PictureBoxPublic Event RButtonDown()      '鼠标右键按下
Public Event RButtonUp()        '鼠标右键放开
Public Event RButtonDblClick()  '鼠标右键双击
Public Event LButtonDown()      '鼠标左键按下
Public Event LButtonUp()        '鼠标左键放开
Public Event LButtonDblClick()  '鼠标左键双击Private Sub Class_Initialize()
    With mNID
        .lSize = Len(mNID)
        .lCallBackMessage = WM_MOUSEMOVE
        .lFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .lId = 1&
    End With
End SubPrivate Sub Class_Terminate()
    DeleteIcon
    Set mPic = Nothing
End SubPublic Property Let PicBox(ByVal PicBox As PictureBox)
    Set mPic = PicBox
    With mNID
        .hWnd = mPic.hWnd
        .hIcon = mPic
    End With
End PropertyPublic Property Get TipText() As String
    TipText = mNID.szTip
End PropertyPublic Property Let TipText(ByVal TipText As String)
    mNID.szTip = TipText & Chr$(0)
    Shell_NotifyIcon NIM_MODIFY, mNID
End PropertyPublic Function ShowIcon() As Boolean
    If mPic Is Nothing Then
        ShowIcon = False
    Else
        Shell_NotifyIcon NIM_ADD, mNID
        ShowIcon = True
    End If
End FunctionPublic Sub DeleteIcon()
    Shell_NotifyIcon NIM_DELETE, mNID
End SubPrivate Sub mPic_Change()
    mNID.hIcon = mPic
    Shell_NotifyIcon NIM_MODIFY, mNID
End SubPrivate Sub mPic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)    Static bRec As Boolean
    Dim lMsg As Long    lMsg = X / Screen.TwipsPerPixelX    If bRec = False Then
        bRec = True
        Select Case lMsg
            Case WM_LBUTTONDBLCLK:
                '左键双击
                RaiseEvent LButtonDblClick
            Case WM_LBUTTONDOWN:
                '左键按下
                RaiseEvent LButtonDown
            Case WM_LBUTTONUP:
                '左键放开
                RaiseEvent LButtonUp
            Case WM_RBUTTONDBLCLK:
                '右键双击
                RaiseEvent RButtonDblClick
            Case WM_RBUTTONDOWN:
                '右键按下
                RaiseEvent RButtonDown
            Case WM_RBUTTONUP:
                '右键放开
                RaiseEvent RButtonUp
        End Select
        bRec = False
    End If
End Sub'窗体代码--------------------------------------------
Dim WithEvents Tray As CTray    '托盘图标变量Private Sub Form_Load()
    
    '托盘图标
    Set Tray = New CTray
    With Tray
        .TipText = Me.Caption
        .PicBox = picChange   '一个用于托盘的图标(PictureBox)
    End With
    Tray.ShowIcon   '添加图标在托盘        
End Sub'以下为托盘图标事件=========================================================
Private Sub Tray_LButtonDblClick()
    Text1.Text = "左键双击" '& vbCrLf
End SubPrivate Sub Tray_LButtonDown()
    Text1.Text = "左键按下"
End SubPrivate Sub Tray_LButtonUp()
    Text1.Text = "左键放开"
End SubPrivate Sub Tray_RButtonDblClick()
    Text1.Text = "右键双击"
End SubPrivate Sub Tray_RButtonDown()
    Text1.Text = "右键按下"
End SubPrivate Sub Tray_RButtonUp()
    Text1.Text = "右键放开"
End Subprivate sub form_unload()
    '删除托盘图标
    Tray.DeleteIcon
    Set Tray = Nothing
end sub

Answer 4

不好意思，这个问题我自己解决了
方法是
我在Form_Unload中有个end把它去了就可以了