首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

托盘图标模块疑义

2012-12-28 
托盘图标模块疑问本帖最后由 kk86868058 于 2011-09-19 02:03:26 编辑我不希望在回复得到一个现成的模块代

托盘图标模块疑问
本帖最后由 kk86868058 于 2011-09-19 02:03:26 编辑 我不希望在回复得到一个现成的模块代码
平时用托盘图标都是复制别人的模块用的,但是可移植性比较低,用到好几个公共变量
这次想自己做一个托盘模块,并且自己把托盘图标处理过程理解清楚
无奈知识有限,遇到问题了

添加以下模块,把主窗体改名为FrmMain或者自己到下面说明的函数中修改
执行
SetTray Me.hWnd, NIM_ADD, Me.Icon.Handle, "托盘图标出现了"

程序崩溃,调试后我认为
OldWindowProc = SetWindowLong(Form_hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
这里导致了问题,把这句删除就正常了
对于这一层次的程序原理不太了解,希望得到详解~要怎么解决,代码如下:




'系统托盘图标处理模块
'使用前请先到NewWindowProc函数里修改窗体名称和弹出菜单名称(如果没有菜单则自定义执行内容)
'使用前请先到NewWindowProc函数里修改窗体名称和弹出菜单名称(如果没有菜单则自定义执行内容)
'使用前请先到NewWindowProc函数里修改窗体名称和弹出菜单名称(如果没有菜单则自定义执行内容)
'使用前请先到NewWindowProc函数里修改窗体名称和弹出菜单名称(如果没有菜单则自定义执行内容)
'使用前请先到NewWindowProc函数里修改窗体名称和弹出菜单名称(如果没有菜单则自定义执行内容)

Option Explicit
'API函数声明

'设置托盘图标'
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
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

'========================================================================================'
'========================================================================================'

'数据结构声明
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

'========================================================================================'
'========================================================================================'

'常量声明
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Public Const NIF_MESSAGE = &H1
Public Const WM_USER = &H400
Public Const TRAY_CALLBACK = (WM_USER + 1001&)

Public Const GWL_WNDPROC = (-4)


'========================================================================================'
'========================================================================================'

'变量声明
Private IconData As NOTIFYICONDATA
Public OldWindowProc As Long


Public Sub SetTray(Form_hwnd&, SetMode&, Optional Icon_Handle As Long, Optional Tips As String)
    '设置托盘图标数据结构状态
    With IconData


        .uID = 0
        .hWnd = Form_hwnd
        .cbSize = Len(IconData)
        .uCallbackMessage = TRAY_CALLBACK   '设置图标所响应的消息,,,,我是不是对这个理解有误?
        
        Select Case SetMode
            Case NIM_ADD    '添加托盘图标
                '抢占消息窗口监视过程
                OldWindowProc = SetWindowLong(Form_hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
                
                .hIcon = Icon_Handle
                .szTip = Tips & vbNullChar
                .uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
                

            Case NIM_DELETE '移除托盘图标
                .uFlags = 0
                
            Case NIM_MODIFY   '更换托盘图标
                .hIcon = Icon_Handle
                .szTip = Tips & vbNullChar
                .uFlags = NIF_ICON Or NIF_TIP
        End Select
    End With
    
    '执行设置方式
    Shell_NotifyIcon SetMode, IconData
End Sub

'新的窗口消息监视过程,它将取代原来的窗口消息监视过程
Private Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    'TRAY_CALLBACK消息表示用户单击了托盘图标
    If Msg = TRAY_CALLBACK Then
        '单击的是左键,恢复窗体
        If lParam = WM_LBUTTONUP Then
           FrmMain.Show
        '单击的是右键,弹出快捷菜单
        ElseIf lParam = WM_RBUTTONUP Then
            FrmMain.PopupMenu TheMenu
            Exit Function
        End If
    End If
    '将其他消息传递给原来的窗口消息监视过程处理
    NewWindowProc = CallWindowProc(OldWindowProc, hWnd, Msg, wParam, lParam)


End Function 
[解决办法]
楼主头像的猫很威武。。。呵呵
[解决办法]
现在我把
Private Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

改为Public声明都没用~~~还是崩溃了,求助啊
[解决办法]
http://download.csdn.net/detail/zhao4zhong1/570264
[解决办法]
生成exe后就没问题了.

主要是,你不能调试的时候直接按停止!还有unload的时候一定要清理你的托盘.

热点排行