请问 在 VB 中如何把程序加载到系统托盘上？？ 是用控件还是 API ??

Option ExplicitPublic OldWindowProc As LongPublic TheForm As Form
'【VB声明】
'Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'【说明】
'  此过程暂停一段时间后继续执行。'【参数表】
'dwMilliseconds——暂停时间的毫秒数。
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)'【VB声明】
'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'【说明】
'  此函数发送消息到一个窗口过程'【返回值】
'  Long，依据发送的消息不同而变化'【参数表】
' lpPrevWndFunc----- Long，原来的窗口过程地址' HWnd-------------- Long，窗口句柄' Msg -------------- Long，发送的消息' wParam ----------- Long，消息类型，参考wParam参数表' lParam ----------- Long，依据wParam参数的不同而不同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'【VB声明】
'  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long'【说明】
'  在窗口结构中为指定的窗口设置信息'【返回值】
'  Long，指定数据的前一个值'【参数表】
'  hwnd -----------  Long，欲为其取得信息的窗口的句柄'  nIndex ---------  Long，请参考GetWindowLong函数的nIndex参数的说明'  dwNewLong ------  Long，由nIndex指定的窗口信息的新值
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long'【VB声明】
'Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long'【说明】'在系统托盘区（tasktray status）添加、删除、更改图标'【参数表】
'参数dwMessage ---- 为消息设置值，它可以是以下的几个常数值：0、1、2'NIM_ADD = 0        加入图标到系统状态栏中
'NIM_MODIFY = 1     修改系统状态栏中的图标
'NIM_DELETE = 2     删除系统状态栏中的图标'参数LpData ---- 用以传入NOTIFYICONDATA数据结构变量，我们也需要在"模块"中定义其结构如下：'Type NOTIFYICONDATA
'       cbSize As Long              需填入NOTIFYICONDATA数据结构的长度
'       HWnd As Long                设置成窗口的句柄
'       Uid As Long                 为图标所设置的ID值
'       UFlags As Long              用来设置以下三个参数uCallbackMessage、hIcon、szTip是否有效
'       UCallbackMessage As Long    消息编号
'       HIcon As Long               显示在状态栏上的图标
'       SzTip As String * 64        提示信息
'End Type'---- 其中参数uCallbackMessage、hIcon、szTip也应在模块中声明为以下的常量：
'Public Const NIF_MESSAGE = 1
'Public Const NIF_ICON = 2
'Public Const NIF_TIP = 4Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDOWN = &H204
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 = &H2'记录 设置托盘图标的数据 的数据类型NOTIFYICONDATA
Public 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'TheData变量记录设置托盘图标的数据
Private TheData As NOTIFYICONDATA
' *********************************************
' 新的窗口过程--主程序中采用SetWindowLong函数改变了窗口函数的地址，消息转向由NewWindowProc处理
' *********************************************
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
        '如果点击了右键
        If lParam = WM_RBUTTONUP Then
            '则弹出右键菜单
            frmMain.acbMain.Bands("popSystem").PopupMenu
            Exit Function
        End If
        If lParam = WM_LBUTTONDBLCLK Then
            If TheForm.WindowState = vbNormal Then
                TheForm.WindowState = vbMinimized
                TheForm.Hide
            Else
                TheForm.WindowState = vbNormal
                TheForm.Show
                TheForm.ZOrder 0
            End If
            Exit Function
        End If
    End If
    
    '如果是其他类型的消息则传递给原有默认的窗口函数
    NewWindowProc = CallWindowProc(OldWindowProc, HWnd, Msg, wParam, lParam)
End Function' *********************************************
' 把主窗体的图标（Form1.icon属性可改变）添加到托盘中
' *********************************************
Public Sub AddToTray(frm As Form)    '保存当前窗体和菜单信息
    Set TheForm = frm
    'GWL_WNDPROC获得该窗口的窗口函数的地址
    OldWindowProc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf NewWindowProc)
    
    '知识点滴：HWnd属性
    '返回窗体或控件的句柄。语法: object.HWnd
    '说明:Microsoft Windows 运行环境，通过给应用程序中的每个窗体和控件
    '分配一个句柄（或 hWnd）来标识它们。hWnd 属性用于Windows API调用。    '将主窗体图标添加在托盘中
    With TheData
        .Uid = 0    '忘了吗？参考一下前面内容,Uid图标的序号，做动画图标有用
        .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                                '给主窗体，Or的意思是同时进行设置和返回消息
    Shell_NotifyIcon NIM_ADD, TheData       '根据前面定义NIM_ADD，设置为“添加模式”
End Sub' *********************************************
' 删除系统托盘中的图标
' *********************************************
Public Sub RemoveFromTray()
    '删除托盘中的图标
    With TheData
        .UFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData   '根据前面定义NIM_DELETE，设置为“删除模式”
    
    '恢复原有的设置
    SetWindowLong TheForm.HWnd, GWL_WNDPROC, OldWindowProc
End Sub
' *********************************************
' 为托盘中的图标加上浮动提示（也就是鼠标移上去时出现的提示字条）
' *********************************************
Public Sub SetTrayTip(tip As String)
    With TheData
        .SzTip = tip & vbNullChar
        .UFlags = NIF_TIP   '指明要对浮动提示进行设置
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData    '根据前面定义NIM_MODIFY，设置为“修改模式”
End Sub' *********************************************
' 设置托盘的图标（在本例中没有用到，如果要动态改变托盘内显示的图标，它非常有用）
' 例如：1、显示动画图标（方法你一定猜到了，对！使用Timer控件，不断调用此过程，注意把动画放在pic数组中）
'       2、程序处于不同状态时，显示不同的图标，方法是类似的
' 有兴趣的话试一试吧。
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
    '判断一下pic中存放的是不是图标
    If pic.Type <> vbPicTypeIcon Then Exit Sub    '更换图标为pic中存放的图标
    With TheData
        .HIcon = pic.Handle
        .UFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub'                                                原创，参考API-Guide
'--------------------------------------------------------------------
'直接调用该模块即可?
'---------------------------------------------------------------

解决方案 »

  1.   

    'Download the full source+pictures+... At http://www.geocities.com/SiliconValley/Campus/3636/trayicon.zip
    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
      

  2.   

    Option ExplicitPrivate 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
    Private Const NIM_ADD = &H0
    Private Const NIM_MODIFY = &H1
    Private Const NIM_DELETE = &H2
    Private Const WM_MOUSEMOVE = &H200
    Private Const NIF_MESSAGE = &H1
    Private Const NIF_ICON = &H2
    Private Const NIF_TIP = &H4Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
    Dim t As NOTIFYICONDATA
    Private IsShow As Boolean
    Private Const WM_LBUTTONDOWN As Long = &H201
    Private Const WM_RBUTTONDOWN As Long = &H204Private Sub Form_Load()
        t.szTip = "Test" & Chr$(0)
        t.hWnd = hWnd
        t.uId = 1&
        t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        t.hIcon = ImageList1.ListImages(3).Picture
        t.cbSize = Len(t)
        t.ucallbackMessage = WM_MOUSEMOVE
        Shell_NotifyIcon NIM_ADD, t
        Me.Hide
    End Sub
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        Dim lMsg As Long
        Static bInHere As Boolean
        lMsg = X / Screen.TwipsPerPixelX
        Select Case lMsg
            Case WM_LBUTTONDOWN:
                If IsShow Then
                    IsShow = False
                    Me.Hide
                Else
                    IsShow = True
                    WindowState = 0
                    Me.Show
                End If
            Case WM_RBUTTONDOWN:
                PopupMenu file
        End Select
    End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        t.cbSize = Len(t)
        t.hWnd = hWnd
        t.uId = 1&
        Shell_NotifyIcon NIM_DELETE, t
    End Sub
      

  3.   

    把下面的代码复制到一个模块中:
    _______________________________________________
    Option Explicit
    Public Const WM_CLOSE = &H10
    Public Const WM_DESTROY = &H2Public OldWindowProc As Long
    Public form1 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_LBUTTONDBLCLK = &H203
    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 NOTIFYICONDATAPublic 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
            
            If lParam = WM_LBUTTONUP Then
                   '----------------------
                   '此处写鼠标单击时的代码
                   '----------------------
            End If
            If lParam = WM_LBUTTONDBLCLK Then
                
                   '----------------------
                   '此处写鼠标双击时的代码
                   '----------------------
                
            End If
            If lParam = WM_RBUTTONUP Then
                   '----------------------
                   '此处写鼠标右击时的代码
                   '----------------------
            End If   Else:
          NewWindowProc = CallWindowProc( _
            OldWindowProc, hwnd, Msg, _
            wParam, lParam)
    End If
    End Function
    '添加图标到任务栏Public Sub AddtoTray(frm As Form, mnu As Menu)
        Set form1 = frm
        Set TheMenu = mnu
        
        OldWindowProc = SetWindowLong(form1.hwnd, _
            GWL_WNDPROC, AddressOf NewWindowProc)
        
        With TheData
            .uID = 0
            .hwnd = form1.hwnd
            .cbSize = Len(TheData)
            .hIcon = form1.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'删除任务栏图标Public Sub RemoveFromTray()
       On Error Resume Next
        With TheData
            .uFlags = 0
        End With
        Shell_NotifyIcon NIM_DELETE, TheData
        
       SetWindowLong form1.hwnd, GWL_WNDPROC, OldWindowProc
    End Sub'设置提示Public Sub SetTrayTip(tip As String)
        With TheData
            .szTip = tip & vbNullChar
            .uFlags = NIF_TIP
        End With
        Shell_NotifyIcon NIM_MODIFY, TheData
    End Sub'设置图标Public Sub SetTrayIcon(pic As Picture)
        If pic.Type <> vbPicTypeIcon Then Exit Sub    With TheData
            .hIcon = pic.Handle
            .uFlags = NIF_ICON
        End With
        Shell_NotifyIcon NIM_MODIFY, TheData
    End Sub
      

  4.   

    用控件吧，现成的。在vb6企业版的安装盘就有。
    路径是\COMMON\TOOLS\VB\UNSUPPRT\SYSTRAY
    把这个项目打开并直接编译成ocx控件，注册一下就可以直接使用，非常好用。
      

  5.   

    Option ExplicitPrivate Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Const WM_SYSCOMMAND = &H112
    Private Const SC_RESTORE = &HF120&Private LastState As Integer '保留原窗口状态'---------- dwMessage可以是以下NIM_ADD、NIM_DELETE、NIM_MODIFY 标识符之一----------
    Private Const NIM_ADD = &H0 '在任务栏中增加一个图标
    Private Const NIM_DELETE = &H2 '删除任务栏中的一个图标
    Private Const NIM_MODIFY = &H1 '修改任务栏中个图标信息Private Const NIF_MESSAGE = &H1 'NOTIFYICONDATA结构中uFlags的控制信息
    Private Const NIF_ICON = &H2
    Private Const NIF_TIP = &H4Private Const WM_MOUSEMOVE = &H200 '当鼠标指针移至图标上Private Const WM_LBUTTONUP = &H202
    Private Const WM_RBUTTONUP = &H205Private Type NOTIFYICONDATA
    　cbSize As Long '该数据结构的大小
    　hwnd As Long '处理任务栏中图标的窗口句柄
    　uID As Long '定义的任务栏中图标的标识
    　uFlags As Long '任务栏图标功能控制，可以是以下值的组合（一般全包括）
    　'NIF_MESSAGE 表示发送控制消息；
    　'NIF_ICON表示显示控制栏中的图标；
    　'NIF_TIP表示任务栏中的图标有动态提示。
    　uCallbackMessage As Long '任务栏图标通过它与用户程序交换消息，处理该消息的窗口由hWnd决定
    　hIcon As Long '任务栏中的图标的控制句柄
    　szTip As String * 64 '图标的提示信息
    End TypeDim myData As NOTIFYICONDATAPrivate Sub Form_Load()
    　If WindowState = vbMinimized Then
    　　LastState = vbNormal
    　Else
    　　LastState = WindowState
    　End If　With myData
    　　.cbSize = Len(myData)
    　　.hwnd = Me.hwnd
    　　.uID = 0
    　　.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    　　.uCallbackMessage = WM_MOUSEMOVE
    　　.hIcon = Me.Icon.Handle '默认为窗口图标
    　　.szTip = "提示" & vbNullChar
    　End With　Shell_NotifyIcon NIM_ADD, myDataEnd SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    　Select Case CLng(X)
    　　Case WM_RBUTTONUP '鼠标在图标上右击时弹出菜单
    　　　　Me.PopupMenu mnuTray
    　　Case WM_LBUTTONUP '鼠标在图标上左击时窗口若最小化则恢复窗口位置
    　　　　If Me.WindowState = vbMinimized Then
    　　　　　Me.WindowState = LastState
    　　　　　Me.SetFocus
    　　　　End If
    　End Select
    End SubPrivate Sub Form_Unload(Cancel As Integer)
    　Shell_NotifyIcon NIM_DELETE, myData '窗口卸载时，将状态栏中的图标一同卸载
    End SubPrivate Sub mnuExit_Click()
    　Unload Me
    End SubPrivate Sub mnuTrayChangeIcon_Click()
    　On Error GoTo ErrHandler
    　With cdlOpen
    　　.CancelError = True ' 设置标志
    　　.InitDir = App.Path ' 默认的文件夹为当前文件夹
    　　.Flags = cdlOFNHideReadOnly ' 设置过滤器
    　　.Filter = "图标文件 (*.ico)|*.ico" ' 指定缺省的过滤器为图标文件
    　　.ShowOpen ' 显示选定文件的名字
    　End With　Image1.Picture = LoadPicture(cdlOpen.FileName)　With myData
    　　.hIcon = Image1.Picture
    　　.uFlags = NIF_ICON
    　End With
    　Shell_NotifyIcon NIM_MODIFY, myDataErrHandler: ' 用户按了"取消"按钮
    　　Exit Sub
    End SubPrivate Sub mnuTrayClose_Click()
    　Unload Me
    End SubPrivate Sub Form_Resize()
    　Select Case WindowState
    　　Case vbMinimized
    　　　mnuTrayMaximize.Enabled = True
    　　　mnuTrayMinimize.Enabled = False
    　　　mnuTrayRestore.Enabled = True
    　　Case vbMaximized
    　　　mnuTrayMaximize.Enabled = False
    　　　mnuTrayMinimize.Enabled = True
    　　　mnuTrayRestore.Enabled = True
    　　Case vbNormal
    　　　mnuTrayMaximize.Enabled = True
    　　　mnuTrayMinimize.Enabled = True
    　　　mnuTrayRestore.Enabled = False
    　End Select
    　If WindowState <> vbMinimized Then LastState = WindowState
    End SubPrivate Sub mnuTrayMaximize_Click()
    　WindowState = vbMaximized
    End SubPrivate Sub mnuTrayMinimize_Click()
    　WindowState = vbMinimized
    End SubPrivate Sub mnuTrayRestore_Click()
    　SendMessage hwnd, WM_SYSCOMMAND, SC_RESTORE, 0&
    End Sub ---------------------------------------------------------
    Montaque==Digitalboy==Houyong
      

  6.   

    GetWindowLong() API---------------------------------------------------------
    Montaque==Digitalboy==Houyongfeng==Monkey
      

  7.   

    用控件方便，vb自带的，在samples目录中，编译后可以正常使用。
      

  8.   

    '这是一个将图标添加到Windows任务栏系统通知区的程序，同其他用VB编写的程序不同，这个程序可以响应鼠标事件'''建立一个模块Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
    Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hicon As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Type POINTAPI
        x As Long
        y As Long
    End TypePublic 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 TypePublic Const NIM_ADD = 0             '添加图标
    Public Const NIM_MODIFY = 1          '修改图标
    Public Const NIM_DELETE = 2          '删除图标Public Const NIF_MESSAGE = 1         '当有鼠标事件发生时产生消息
    Public Const NIF_ICON = 2            '
    Public Const NIF_TIP = 4             '图标有提示字符串
    Public Const WM_LBUTTONDOWN = &H201
    Public Const WM_RBUTTONDOWN = &H204
    Public Const WM_USER = &H400
    Public Const WM_NOTIFYICON = WM_USER + &H100
    Public Const WM_COMMAND = &H111
    Public Const WM_DESTROY = &H2
    Public Const WM_DRAWITEM = &H2B
    Public Const WM_INITDIALOG = &H110
    Public Const WM_PAINT = &HF
    Public Const WM_MENUSELECT = &H11FPublic Const GWL_WNDPROC = (-4) '替换窗口处理函数Global lproc As Long
    Function Icon_Del(ihwnd As Long) As Long
      Dim ano As NOTIFYICONDATA
      ano.hwnd = ihwnd
      ano.uID = 0
      ano.cbSize = Len(ano)
      '删除图标
      Icon_Del = Shell_NotifyIcon(NIM_DELETE, ano)
    End Function
    '这个函数接收图标句柄和窗口句柄并且新建图标
    Function Icon_Add(ihwnd As Long, hicon As Long) As Long
      Dim ano As NOTIFYICONDATA
      Dim astr As String
      
      '为图标添加提示行
      astr = "VB程序" 'LTrim$(InputBox$("Input the tips you wanted to add."))
      ano.szTip = astr + Chr$(0)
      '设置消息接收窗口
      ano.hwnd = ihwnd
      ano.uID = 0
      '图标有提示并且可以发送消息
      ano.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
      ano.hicon = hicon
      ano.cbSize = Len(ano)
      '将图标的回调消息设置为WM_NOTIFYICON，当在图标区域有鼠标消息，系统就会向
      '消息接收窗口发送WM_NOTIFYICON消息。
      ano.uCallbackMessage = WM_NOTIFYICON
      Icon_Add = Shell_NotifyIcon(NIM_ADD, ano)
    End FunctionFunction DialogProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    '该函数为Form1的窗口处理函数。
      Dim l As Long
      Dim po As POINTAPI
      Select Case uMsg
        Case WM_INITDIALOG
        Case WM_DESTROY
        Case WM_COMMAND
        Case WM_DRAWITEM
        Case WM_NOTIFYICON  '有鼠标事件产生
          Select Case lParam
            Case WM_LBUTTONDOWN     '按下鼠标左键
              '提示是否删除图标
              l = MsgBox("Delete icon?", vbYesNo)
              If l = vbYes Then
                '删除图标同时恢复窗口处理函数
                l = Icon_Del(hwnd)
                l = SetWindowLong(Form1.hwnd, GWL_WNDPROC, lproc)
                Form1.Show
              End If
           End Select
        Case Else
          DialogProc = False
      End Select
      DialogProc = True
    End Function
    ''''在form1上放二个button和一个picture1Private Sub Command1_Click()
        If (Icon_Add(Form1.hwnd, Picture1.Picture)) Then
        Command1.Enabled = False
        Form1.Hide
        '将DialogProc函数设置为Form1的窗口处理函数并且保存原来窗口处理函数句柄
        lproc = SetWindowLong(Form1.hwnd, GWL_WNDPROC, AddressOf DialogProc)
      End If
    End SubPrivate Sub Command2_Click()
      End
    End Sub
      

  9.   

    你把我给的代码直接copy就能用
      

  10.   

    我记得，在VB的安装盘中有个一控件 systray(好像是，记不太清楚了)你可以到光盘上找找，很好用的，原来我就是这么些的
      

  11.   

    用控件比较方便，而且比较健壮，方便调试。api调试有时会僵死..