请问，怎样让vb在时间旁边留个小图标啊。

Question

用API函数
'用来设置系统托盘中的图标
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" ( _
    ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
    
 '定义一些用到的常量
Private Const HWND_TOPMOST = -1
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 = &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
Private MyIco As NOTIFYICONDATA
Private Sub Form_Load()
   '设置任务托盘上的图标
    With MyIco
        .hwnd = start.hwnd
        .uId = 1&
        .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
        .ucallbackMessage = WM_MOUSEMOVE
        .hIcon = ImgIco.Picture
        .szTip = "正在导入数据,请稍后...." & Chr$(0)
    End With
    Shell_NotifyIcon NIM_ADD, MyIco     '加载系统图标
 End Sub
'关闭图标
Private Sub FormUnload()
     
    MyIco.hwnd = start.hwnd
    MyIco.uId = 1&
    Shell_NotifyIcon NIM_DELETE, MyIco
End Sub

Answer 1

'下面的代码是一个标准模块，添加到工程里就可用了，不太好理解，
'你可以留下信箱给你发个源程序
'窗体最小化到系统托盘（即在时间旁显示小图标）调用addicon过程
'退出土盘图标状态调用delicon过程，退出程序前一定要调用
'iconshow过程是设置图标的提示文本
'changeicon是动态变换图标的Option ExplicitPublic thefrm As Form
Public themnu As Menu
Public oldwindowproc As LongPublic 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const WM_USER = &H400
Public Const TRAY_CALLBACK = (WM_USER + 1001&) 
   
'其中各参数的意义如下表:'参数:  意义
'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
Private theData As NOTIFYICONDATA
    '返回值 Long，非零表示成功，零表示失败
    
:      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_LBUTTONUP Then
                '恢复到最小化前的窗体状态
                thefrm.WindowState = 0
                thefrm.Show
                delicon
                Exit Function
          End If
          '如果点击了右键
          If lParam = WM_RBUTTONUP Then
              '则弹出右键菜单
              thefrm.PopupMenu themnu
              Exit Function
          End If
      End If
      '如果是其他类型的消息则传递给原有默认的窗口函数
      NewWindowProc = CallWindowProc(oldwindowproc, HWnd, Msg, wParam, lParam)
      End Function
   
    
    
    
    
    '*********************************************]
'添加图标
Sub addicon(frm As Form, mnu As Menu)'前一个参数是要添加图标的窗体，后一个是窗体的弹出菜单。
Set thefrm = frm
Set themnu = mnuoldwindowproc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf NewWindowProc)
  
With theData
        .Uid = 0
        .HWnd = frm.HWnd              'frm.HWnd是程序主窗体的句柄
        .cbSize = Len(theData)
        .HIcon = frm.Icon.Handle    'frm.Icon.Handle指向主窗体的图标
        .UFlags = NIF_ICON
        .UCallbackMessage = TRAY_CALLBACK
         '作用是允许返回消息，在下一节中会有详细解释。
        .UFlags = .UFlags Or NIF_MESSAGE
        .cbSize = Len(theData)
      End With
      Shell_NotifyIcon NIM_ADD, theData
      thefrm.Visible = False
    '根据前面定义NIM_ADD，设置为“添加模式”，然后添加
End Sub
  
'删除图标
Sub delicon()
With theData
        .UFlags = 0
End With
Shell_NotifyIcon NIM_DELETE, theData
'根据前面定义NIM_DELETE，设置为“删除模式”SetWindowLong thefrm.HWnd, GWL_WNDPROC, oldwindowproc
End Sub
'更改图标
 Sub changeicon(pic As Picture)
 With theData
    .HIcon = pic.Handle
    'pic是图片PictureBox，存放图标文件
    .UFlags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, theData
'根据前面定义NIM_MODIFY，设置为“更改模式”
 End Sub
'图标提示
Sub iconshow(tip As String)
With theData
        .SzTip = tip & vbNullChar
           'tip是字符串string，存储提示信息
        .UFlags = NIF_TIP
        '指明要对浮动提示进行设置
End With
Shell_NotifyIcon NIM_MODIFY, theData
'根据前面定义NIM_MODIFY，设置为“修改模式”
End Sub

Answer 2

'in .basOption ExplicitPublic 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.
            If TheForm.WindowState = vbMinimized Then _
                TheForm.WindowState = TheForm.LastState
            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'in formPublic LastState As Long'先设置FORM属性ShowInTaskbar = FalsePrivate Sub Form_Load()    AddToTray Me, mnuTray 'mnuTray is right menu
    SetTrayTip "pro tip"end subPrivate Sub Form_Resize()    If WindowState <> vbMinimized Then _
        LastState = WindowStateEnd SubPrivate Sub Form_Unload(Cancel As Integer)
  
  If MsgBox("您真的要退出程序吗？", vbYesNo + vbDefaultButton2 + vbQuestion, "关闭程序") = vbYes Then
    RemoveFromTray
Else
    Cancel = -1
End IfEnd Sub