如何把程序最小化到系统托盘里(在桌面的右小角),请指教！

Question

1)  同上
2)  如何得到本机的IP地址和机器名。
另外给分 谢谢

Answer 1

'-----------------------------------
'窗体
'mnuTray  菜单
Private Sub Form_Load()
    '调用添加托盘图标子程序
    AddToTray Me, mnuTray
    '调用在托盘图标上显示提示的子程序
    SetTrayTip "叶帆软件"
End Sub'在窗体退出后，删除托盘中的图标
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    '移除系统托盘
    RemoveFromTray
End Sub
'-----------------------------------
'模块
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
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
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 Long
Public 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 = &H2
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
Private TheData As NOTIFYICONDATA
'新的窗口程序，它将取代原来的窗口程序
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
           TheForm.WindowState = 0
        End If
        '单击的是右键，弹出快捷菜单
        If lParam = WM_RBUTTONUP Then
            TheForm.PopupMenu TheMenu
            Exit Function
        End If
    End If
    '将其他消息传递给原来的窗口程序
    NewWindowProc = CallWindowProc(OldWindowProc, hwnd, Msg, wParam, lParam)
End Function
'将程序图标添加到系统托盘区
Public Sub AddToTray(frm As Form, mnu As Menu)
    '保存变量以供其他处引用
    Set TheForm = frm
    Set TheMenu = mnu
    '装载新的窗口程序
    OldWindowProc = SetWindowLong(frm.hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
    ' 将程序图标添加到系统托盘区
    With TheData
        .uID = 0
        .hwnd = frm.hwnd
        .cbSize = Len(TheData)
        .hIcon = frm.Icon.Handle
        .uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
        .uCallbackMessage = TRAY_CALLBACK
        .uFlags = .uFlags Or NIF_MESSAGE
        .cbSize = Len(TheData)
    End With
    Shell_NotifyIcon NIM_ADD, TheData
End Sub
'将图标从系统托盘区中删除
Public Sub RemoveFromTray()
    With TheData
        .uFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData
    ' 恢复原来的窗口程序 .
    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
End Sub

Answer 2

要得到本机的IP地址和机器名用一个WinSock控件。
这个方法比较方便，也可以用API但比较复杂。

Answer 3

1.
Option ExplicitPrivate Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" _
          (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Function SetForegroundWindow Lib "user32" _
          (ByVal hWnd As Long) As LongPrivate Declare Function ShowWindow& Lib "user32" (ByVal hWnd&, ByVal nCmdShow&)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 SW_RESTORE As Long = 9&Private 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 = &H4             '
Private 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 = &H206  'Private Nid As NOTIFYICONDATAPrivate Sub Form_Activate()
 
  With Nid
    .cbSize = Len(Nid)
    .hWnd = Me.hWnd
    .uId = vbNull    '托盘有图标+提示+信息
    .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE    '鼠标移动时消息,回调
    .uCallBackMessage = WM_MOUSEMOVE
    .hIcon = Me.Icon
    .szTip = "托盘" & vbNullChar
  End With
 
  '托盘上加上图标
  Shell_NotifyIcon NIM_ADD, Nid
  
End SubPrivate Sub Form_Unload(Cancel As Integer)
   
   '移去托盘图标
   Shell_NotifyIcon NIM_DELETE, Nid
   Set frmSystray = Nothing
   
End Sub
2.
在模块里面添加如下代码
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
Dim strIP As String
Private Const MAX_IP = 255
Private Type IPINFO
    dwAddr As Long
    dwIndex As Long
    dwMask As Long
    dwBCastAddr As Long
    dwReasmSize As Long
    unused1 As Integer
    unused2 As Integer
End Type
Private Type MIB_IPADDRTABLE
    dEntrys As Long
    mIPInfo(MAX_IP) As IPINFO
End Type
Private Type IP_Array
    mBuffer As MIB_IPADDRTABLE
    BufferLen As Long
End TypePrivate Sub main()
     Start
     MsgBox strIP
End Sub
   
Private Function ConvertAddressToString(longAddr As Long) As String
    Dim myByte(3) As Byte
    Dim Cnt As Long
    CopyMemory myByte(0), longAddr, 4
    For Cnt = 0 To 3
    ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "."
    Next Cnt
    ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1)
End Function
 
Public Sub Start()
    Dim Ret As Long, Tel As Long
    Dim bBytes() As Byte
    Dim Listing As MIB_IPADDRTABLE
    On Error GoTo END1
    GetIpAddrTable ByVal 0&, Ret, True
    If Ret <= 0 Then Exit Sub
    ReDim bBytes(0 To Ret - 1) As Byte
    GetIpAddrTable bBytes(0), Ret, False
    CopyMemory Listing.dEntrys, bBytes(0), 4
    strIP = "你机子上有" & Listing.dEntrys & " 个 IP 地址" & vbCrLf
    strIP = strIP & "------------------------------------------------" & vbCrLf & vbCrLf
    For Tel = 0 To Listing.dEntrys - 1
    CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel))
    strIP = strIP & "IP 地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) & vbCrLf
    strIP = strIP & "子网掩码: " & ConvertAddressToString(Listing.mIPInfo(Tel).dwMask) & vbCrLf
    strIP = strIP & "广播地址 : " & ConvertAddressToString(Listing.mIPInfo(Tel).dwBCastAddr) & vbCrLf
    strIP = strIP & "------------------------------------------------" & vbCrLf
    Next
    Exit Sub
END1:
    MsgBox "ERROR"
End Sub