虚拟主机教程

'一、为了代码简洁首先还是添个“模块”，粘贴如下代码
'API函数声明--图标操作
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
 
Public Const DefaultIconIndex = 1 '图标缺省索引
Public Const WM_LBUTTONDOWN = &H201 '按鼠标左键
Public Const WM_RBUTTONDOWN = &H204 '按鼠标右键
Public Const NIM_ADD = 0 '添加图标
Public Const NIM_MODIFY = 1 '修改图标
Public Const NIM_DELETE = 2 '删除图标
Public Const NIF_MESSAGE = 1 'message 有效
Public Const NIF_ICON = 2 '图标操作（添加、修改、删除）有效
Public Const NIF_TIP = 4 'ToolTip(提示）有效
Public Const NIF_STATE = &H8
Public Const NIF_INFO = &H10
'气泡提示类型
Public Const NIIF_NONE = &H0
Public Const NIIF_WARNING = &H2
Public Const NIIF_ERROR = &H3
Public Const NIIF_INFO = &H1
Public Const NIIF_GUID = &H4
 
'自定义数据类型
Public Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 128   '如果为64则不能泡
    '气泡提示信息部分
    dwState As Long
    dwStateMask As Long
    szInfo As String * 256               '气泡提示内容
    uTimeout As Long                     '气泡提示显示时间
    szInfoTitle As String * 64           '气泡提示标题
    dwInfoFlags As Long                  '气泡提示类型，见 NIIF_*** 部
End Type
 
'函数定义--'添加图标至通知栏
Public Function Icon_Add(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
  '参数说明：iHwnd：窗口句柄，sTips：当鼠标移到通知栏图标上时显示的提示内容
  'hIcon：图标句柄，IconID：图标Id号
  Dim IconVa As NOTIFYICONDATA
  With IconVa
    .hwnd = iHwnd
    .szTip = sTips + Chr$(0)
    .hIcon = hIcon
    .uID = IconID
    .uCallbackMessage = WM_LBUTTONDOWN
    .cbSize = Len(IconVa)
    .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
    Icon_Add = Shell_NotifyIcon(NIM_ADD, IconVa)
  End With
End Function
'气泡提示消息..
Public Function Icon_pop(iHwnd As Long, hIcon As Long, sTitle As String, sBody As String)
  Dim IconVa As NOTIFYICONDATA
  With IconVa
    .szInfoTitle = sTitle & Chr(0)
    .szInfo = sBody & Chr(0)
    .cbSize = Len(IconVa)
    .hwnd = iHwnd
    .uID = 0
    .uFlags = NIF_ICON Or NIF_INFO Or NIF_MESSAGE Or NIF_TIP
    .uCallbackMessage = WM_LBUTTONDOWN
    .hIcon = hIcon
    '.szTip = "这里设置鼠标移到图标上的提示suntw.com" & vbNullChar
  End With
  Icon_pop = Shell_NotifyIcon(NIM_MODIFY, IconVa)
End Function
 
'删除通知栏图标(参数说明同Icon_Add)
Function Icon_Del(iHwnd As Long, lIndex As Long) As Long
  Dim IconVa As NOTIFYICONDATA
  Dim L As Long
  With IconVa
    .hwnd = iHwnd
    .uID = lIndex
    .cbSize = Len(IconVa)
  End With
  Icon_Del = Shell_NotifyIcon(NIM_DELETE, IconVa)
End Function
'修改通知栏图标(参数说明同Icon_Add)
Public Function Icon_Modify(iHwnd As Long, sTips As String, hIcon As Long, IconID As Long) As Long
  Dim IconVa As NOTIFYICONDATA
  With IconVa
    .hwnd = iHwnd
    .szTip = sTips + Chr$(0)
    .hIcon = hIcon
    .uID = IconID
    .uCallbackMessage = WM_LBUTTONDOWN
    .cbSize = Len(IconVa)
    .uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
    Icon_Modify = Shell_NotifyIcon(NIM_MODIFY, IconVa)
  End With
End Function
 
 
 
 
 
 
'二、然后  -  以下是在主窗体中添加代码
Private Sub Command1_Click()    '将图标加入系统栏
    Call Icon_Add(Me.hwnd, Me.Caption, Me.Icon, 0)
End Sub
 
Private Sub Command2_Click()    '气泡式弹出提示
    Call Icon_pop(Me.hwnd, Me.Icon, "标题cc", "提示信息xxx")
End Sub
 
Private Sub Form_Unload(Cancel As Integer)    '将图标移除系统栏
    Call Icon_Del(Me.hwnd, 0)
End Sub
 
Private Sub MenuTest1_Click()   '点击弹出的第一个子菜单时
    MsgBox "ok"
End Sub
 
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim L As Long
    L = X \ 15
    If L = WM_LBUTTONDOWN Then
        Me.PopupMenu mnuControl     '如果点左键，弹出mnuControl菜单。
    ElseIf L = WM_RBUTTONDOWN Then
        Call Icon_Modify(Me.hwnd, Me.Caption, LoadPicture("c:\WINDOWS\Cursors\arrow_i.cur"), 0)
    End If
End Sub