急========我的VB程序系统托盘不行了,原来是可以的,定义另一个模块就不行,请教

[aamiiLA]

这两个模块有什么冲突,造成我的VB系统托盘图标无法通过点击弹出菜单和还原显示窗体呢?

模块一和模块二原来单独的时候都是可以的,就算是放在一个工程中,除了托盘无法正常运行,其它的都正常.

请高手帮忙找出冲突的地方,



原来的模块一(是托盘模块,是可以的):

Option Explicit

'使用高分辨率图标所用的API
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const IMAGE_ICON = 1
'系统托盘
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_STATE = &H8
Private Const NIF_INFO = &H10
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const NIM_SETFOCUS = &H3
Private Const NIM_SETVERSION = &H4
Private Const NIM_VERSION = &H5
Private Const WM_USER As Long = &H400
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)
Private Const NOTIFYICON_VERSION = 3
Private Const NIS_HIDDEN = &H1
Private Const NIS_SHAREDICON = &H2
Private Const WM_NOTIFY As Long = &H4E
Private Const WM_COMMAND As Long = &H111
Private Const WM_CLOSE As Long = &H10
Private Const WM_MOUSEMOVE As Long = &H200
Private Const WM_LBUTTONDOWN As Long = &H201
Private Const WM_LBUTTONUP As Long = &H202
Private Const WM_LBUTTONDBLCLK As Long = &H203
Private Const WM_MBUTTONDOWN As Long = &H207
Private Const WM_MBUTTONUP As Long = &H208
Private Const WM_MBUTTONDBLCLK As Long = &H209
Private Const WM_RBUTTONDOWN As Long = &H204
Private Const WM_RBUTTONUP As Long = &H205
Private Const WM_RBUTTONDBLCLK As Long = &H206

Public Enum bFlag
    NIIF_NONE = &H0
    NIIF_INFO = &H1
    NIIF_WARNING = &H2
    NIIF_ERROR = &H3
    NIIF_GUID = &H5
    NIIF_ICON_MASK = &HF
    NIIF_NOSOUND = &H10 '关闭提示音标志
End Enum

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
    uTimeoutAndVersion As Long
    szInfoTitle As String * 64
    dwInfoFlags As Long
End Type

'鼠标事件
Public Enum TrayRetunEventEnum
    MouseMove = &H200
    LeftUp = &H202
    LeftDown = &H201
    LeftDbClick = &H203
    RightUp = &H205
    RightDown = &H204
    RightDbClick = &H206
    MiddleUp = &H208
    MiddleDown = &H207
    MiddleDbClick = &H209
    BalloonClick = (WM_USER + 5)
End Enum

Public ni As NOTIFYICONDATA
Public Sub TrayAddIcon(ByVal MyForm As Form, ByVal ToolTip As String, Optional ByVal bFlag As bFlag)

    With ni
        .cbSize = Len(ni)
        .hwnd = MyForm.hwnd
        .uid = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .uCallbackMessage = WM_MOUSEMOVE
        .hIcon = Form4.Icon
        .szTip = ToolTip & vbNullChar
    End With
    
    Call Shell_NotifyIcon(NIM_ADD, ni)

End Sub

Public Sub TrayRemoveIcon()

    Shell_NotifyIcon NIM_DELETE, ni
    
End Sub

Public Sub TrayBalloon(ByVal MyForm As Form, ByVal sBaloonText As String, sBallonTitle As String, Optional ByVal bFlag As bFlag)

    With ni
        .cbSize = Len(ni)
        .hwnd = MyForm.hwnd
        .uid = vbNull
        .uFlags = NIF_INFO
        .dwInfoFlags = bFlag
        .szInfoTitle = sBallonTitle & vbNullChar
        .szInfo = sBaloonText & vbNullChar
    End With

    Shell_NotifyIcon NIM_MODIFY, ni

End Sub

Public Sub TrayTip(ByVal MyForm As Form, ByVal sTipText As String)

    With ni
        .cbSize = Len(ni)
        .hwnd = MyForm.hwnd
        .uid = vbNull
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .szTip = sTipText & vbNullChar
    End With

    Shell_NotifyIcon NIM_MODIFY, ni

End Sub

[aamiiLA]

没有出错提示,只是当最小化收缩到托盘后,无法点击托盘将窗体再弹出来,原有的托盘右键菜单也无法弹出了.
但是原来是可以的.

[aamiiLA]

新增的模块二(这个是另一个模块,也是可以的):

' -----------------
' ADVAPI32
' -----------------
' function prototypes, constants, and type definitions
' for Windows 32-bit Registry API

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const ERROR_SUCCESS = 0&


' Registry API prototypes

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Const REG_SZ = 1                         ' Unicode nul terminated string
Public Const REG_DWORD = 4                      ' 32-bit number
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long


Public Function EnumKeys(hKey As Long, strPath As String, ByRef clKeys As Collection)
'枚举指定路径下所有主键 clKeys是一个集合,用来返回结果
    Dim Ret As Long, Name As String, idx As Long
    
    Dim i As Integer
    
    Set clKeys = New Collection

    idx = 0
    Name = String(256, Chr(0))
    Dim R, keyh
    R = RegOpenKey(hKey, strPath, keyh)
    
    Do
        Ret = RegEnumKey(keyh, idx, Name, Len(Name))
        If Ret = 0 Then
            clKeys.add Left(Name, InStr(Name, Chr(0)) - 1)
            idx = idx + 1
        End If
    Loop Until Ret <> 0
    
End Function

Public Sub savekey(hKey As Long, strPath As String)
    Dim keyhand&
    R = RegCreateKey(hKey, strPath, keyhand&)
    R = RegCloseKey(keyhand&)
End Sub

'路径是否存在
Public Function isExistPath(hKey As Long, strPath As String) As Boolean
    Dim keyhand As Long
    Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    R = RegOpenKey(hKey, strPath, keyhand)
    isExistPath = True
    If R <> 0 Then isExistPath = False
End Function

'某项是否存在
Public Function isExistKey(hKey As Long, strPath As String, strValue As String) As Boolean
    Dim keyhand As Long
    Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    R = RegOpenKey(hKey, strPath, keyhand)
    isExistKey = True
    If R <> 0 Then isExistKey = False: Exit Function
    lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
    If lResult <> 0 Then isExistKey = False: Exit Function
End Function

Public Function getString(hKey As Long, strPath As String, strValue As String)

    Dim keyhand As Long
    Dim datatype As Long
    Dim lResult As Long
    Dim strBuf As String
    Dim lDataBufSize As Long
    Dim intZeroPos As Integer
    R = RegOpenKey(hKey, strPath, keyhand)
    
    lResult = RegQueryValueEx(keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
    
    If lValueType = REG_SZ Then
        strBuf = String(lDataBufSize, " ")
        lResult = RegQueryValueEx(keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
        If lResult = ERROR_SUCCESS Then
            intZeroPos = InStr(strBuf, Chr$(0))
            If intZeroPos > 0 Then
                getString = Left$(strBuf, intZeroPos - 1)
            Else
                getString = strBuf
            End If
        End If
    End If
    
    If Len(getString) = 0 Then getString = ""
End Function


Public Sub saveString(hKey As Long, strPath As String, strValue As String, strdata As String)
    Dim keyhand As Long
    Dim R As Long
    R = RegCreateKey(hKey, strPath, keyhand)
    R = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, LenB(strdata))
    R = RegCloseKey(keyhand)
End Sub


Function getdword(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String) As Long
    Dim lResult As Long
    Dim lValueType As Long
    Dim lBuf As Long
    Dim lDataBufSize As Long
    Dim R As Long
    Dim keyhand As Long

    R = RegOpenKey(hKey, strPath, keyhand)

    ' Get length/data type
    lDataBufSize = 4

    lResult = RegQueryValueEx(keyhand, strValueName, 0&, lValueType, lBuf, lDataBufSize)

    If lResult = ERROR_SUCCESS Then
        If lValueType = REG_DWORD Then
            getdword = lBuf
        End If
        'Else
        '    Call errlog("GetDWORD-" & strPath, False)
    End If

    R = RegCloseKey(keyhand)

End Function

Function SaveDword(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, ByVal lData As Long)
    Dim lResult As Long
    Dim keyhand As Long
    Dim R As Long
    R = RegCreateKey(hKey, strPath, keyhand)
    lResult = RegSetValueEx(keyhand, strValueName, 0&, REG_DWORD, lData, 4)
    'If lResult <> error_success Then Call errlog("SetDWORD", False)
    R = RegCloseKey(keyhand)
End Function

Public Function DeleteKey(ByVal hKey As Long, ByVal strKey As String)
    Dim R As Long
    Dim tStr
    Dim keyhand As Long
    tStr = Split(strKey, "\")
    strKey = ""
    Dim i As Integer
    For i = 0 To UBound(tStr) - 1
        strKey = strKey & tStr(i) & "\"
    Next
    strKey = Left(strKey, Len(strKey) - 1)
    R = RegOpenKey(hKey, strKey, keyhand)
    
    DeleteKey = RegDeleteKey(keyhand, tStr(UBound(tStr)))
    R = RegCloseKey(keyhand)
End Function

Public Function DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String)
    Dim keyhand As Long
    R = RegOpenKey(hKey, strPath, keyhand)
    R = RegDeleteValue(keyhand, strValue)
    R = RegCloseKey(keyhand)
End Function

[嗷嗷叫的老马]

http://www.m5home.com/blog2/blogview.asp?logID=217&cateID=2

用这个类加进去看看.

没有完整工程,不好抓你程序的BUG.

[aamiiLA]

自己顶一下.

[goosen]

出错提示什么

[舉杯邀明月]

路过……顶贴…………