Question

如何让VB程序后台运行，且任务栏有图标

本人用VB6.0写了一个程序，想让它在点击“最小化”时后台运行，且在任务栏有图标，双击图标可打开原窗口，望各位大虾赐教！

Answer 1

vb 窗口最小到时间边上从底部弹出

1、新建立一个VB6工程，将Form1的ShowInTaskBar属性设置为False -----------------------------------------------

2、菜单：工程--添加模块 按“打开”这样就添加了一个新模块，名为Module1,保存为Module1.bas -------------------

3、在Module1中写下如下代码： ------------------------------------------------------------------------------

Option Explicit
Public Const MAX_TOOLTIP As Integer = 64
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 WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0
Public nfIconData As 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 * MAX_TOOLTIP
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

4、在Form1的代码全部如下：-----------------------------------------------------------------------------

Private Sub Form_Load()
'以下把程序放入System Tray====================================System Tray Begin
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
'定义鼠标移动到托盘上时显示的Tip
.szTip = App.Title + "(版本 " & App.Major & "." & App.Minor & "." & App.Revision & ")" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONUP
'MsgBox "请用鼠标右键点击图标!", vbInformation, "实时播音专家"
'单击左键，显示窗体
ShowWindow Me.hWnd, SW_RESTORE
'下面两句的目的是把窗口显示在窗口最顶层
'Me.Show
'Me.SetFocus
'' Case WM_RBUTTONUP
'' PopupMenu MenuTray '如果是在系统Tray图标上点右键，则弹出菜单MenuTray
'' Case WM_MOUSEMOVE
'' Case WM_LBUTTONDOWN
'' Case WM_LBUTTONDBLCLK
'' Case WM_RBUTTONDOWN
'' Case WM_RBUTTONDBLCLK
'' Case Else
End Select
End Sub

7、现在将程序保存起来运行看看系统托盘处是否增加了一个本工程的图标。单击此图标，Form1就自动弹出来了

Answer 2

Option Explicit

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

Dim WithEvents SysIcon As CSystrayIcon

Private Sub Form_Load()
Set SysIcon = New CSystrayIcon
SysIcon.Initialize hWnd, Picture1.Picture, "Hello World"
SysIcon.ShowIcon
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim msgCallBackMessage As Long

msgCallBackMessage = X / Screen.TwipsPerPixelX

Select Case msgCallBackMessage
Case WM_MOUSEMOVE
txtCallbackMessage.Text = "鼠标经过"
Case WM_LBUTTONDOWN
txtCallbackMessage.Text = "单击左键"
Me.Show
Case WM_LBUTTONUP
txtCallbackMessage.Text = "左键拖动"
Case WM_LBUTTONDBLCLK
txtCallbackMessage.Text = "双击左键"
Case WM_RBUTTONDOWN
txtCallbackMessage.Text = "单击右键"
Me.Hide
Case WM_RBUTTONUP
txtCallbackMessage.Text = "右键拖动"
Case WM_RBUTTONDBLCLK
txtCallbackMessage.Text = "双击右键"
End Select
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'隐藏托盘图标
SysIcon.HideIcon
End Sub

Private Sub SysIcon_NIError(ByVal ErrorNumber As Long)
'异常错误,退出程序 ErrorNumber
Unload Me
End Sub

创建一个类模块(命名CSystrayIcon):

Option Explicit

Private Declare Function GetLastError Lib "kernel32" () As Long
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Const NIM_ADD = &H0 'Add a new icon to the Systray
Private Const NIM_MODIFY = &H1 'Modify an existing icon
Private Const NIM_DELETE = &H2 'Delete an existing icon
Private Const NIF_MESSAGE = &H1 'Tell that the message has been updated
Private Const NIF_ICON = &H2 'Tell that the icon picture has been changed
Private Const NIF_TIP = &H4 'Tell that a new ToopTip for the icon is set

Private Const WM_MOUSEMOVE = &H200 'Used as the ID of the callback message

Private Const MAX_TIP_LENGTH As Long = 64 'This is the max length
'of a ToolTip. This value has been tested for Win95.
'For Win98 and NT, try changing this value. Tell me
'if it is a different value.

Private Type NOTIFYICONDATA
cbSize As Long 'The size of this type
hWnd As Long 'The hWnd that will receive the CallBack message
uId As Long 'The ID of the application. Zero represent this application
uFlags As Long 'The flags. Look at the constants beginning by NIF_ for the flags and their definition
uCallbackMessage As Long 'This is the callback message
hIcon As Long
szTip As String * MAX_TIP_LENGTH
End Type

Private nidTrayIcon As NOTIFYICONDATA

Private bIconDisplayed As Boolean 'The status of the icon. True=Displayed
Private bUpdateOnChange As Boolean
Public Event NIError(ByVal ErrorNumber As Long)

Public Function Initialize(ByVal hWnd As Long, ByVal hIcon As Long, ByVal sTip As String, Optional ByVal uCallbackMessage As Long = WM_MOUSEMOVE) As Long
With nidTrayIcon
.cbSize = Len(nidTrayIcon)
.hIcon = hIcon
.hWnd = hWnd
.szTip = Left(sTip, MAX_TIP_LENGTH - 1) & vbNullChar
.uCallbackMessage = uCallbackMessage
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uId = vbNull
End With
bIconDisplayed = False
bUpdateOnChange = True
End Function

Public Function ShowIcon() As Boolean
If Not bIconDisplayed Then 'If the icon is not already displayed...
ShowIcon = Shell_NotifyIcon(NIM_ADD, nidTrayIcon)
If ShowIcon = False Then 'If there was an error
RaiseEvent NIError(GetLastError) 'Return the error number
Else
bIconDisplayed = True 'The icon is displayed
End If
End If
End Function

Public Function HideIcon() As Boolean
If bIconDisplayed Then 'If the icon is displayed...
HideIcon = Shell_NotifyIcon(NIM_DELETE, nidTrayIcon)
If HideIcon = False Then
RaiseEvent NIError(GetLastError)
Else
bIconDisplayed = False
End If
End If
End Function

Public Property Let IconHandle(ByVal hIcon As Long)
nidTrayIcon.hIcon = hIcon
If bUpdateOnChange Then
nidTrayIcon.uFlags = NIF_ICON
Update 'Make the icon change appear
nidTrayIcon.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
End If
End Property

Public Property Let TipText(ByVal sTip As String)
nidTrayIcon.szTip = Left(sTip, MAX_TIP_LENGTH - 1) & vbNullChar
If bUpdateOnChange Then
nidTrayIcon.uFlags = NIF_TIP
Update
nidTrayIcon.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
End If
End Property

Public Property Let CallbackMessage(ByVal uCallbackMessage As Long)
nidTrayIcon.uCallbackMessage = uCallbackMessage
If bUpdateOnChange Then
nidTrayIcon.uFlags = NIF_MESSAGE
Update
nidTrayIcon.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
End If
End Property

Public Function Update() As Boolean
If bIconDisplayed Then 'The icon must be showed to make change
Update = Shell_NotifyIcon(NIM_MODIFY, nidTrayIcon)
If Update = False Then 'If there was an error
RaiseEvent NIError(GetLastError) 'Return the error number
End If
End If
End Function

Public Property Get IconHandle() As Long
IconHandle = nidTrayIcon.hIcon
End Property

Public Property Get TipText() As String
TipText = Left(nidTrayIcon.szTip, Len(nidTrayIcon.szTip) - 1)
End Property

Public Property Get CallbackMessage() As Long
CallbackMessage = nidTrayIcon.uCallbackMessage
End Property

Public Property Let UpdateOnChange(bUpdate As Boolean)
bUpdateOnChange = bUpdate
End Property

Private Property Get UpdateOnChange() As Boolean
UpdateOnChange = bUpdateOnChange
End Property

Private Sub Class_Terminate()
'The destructor of the class. It remove the icon from the Systray
HideIcon
End Sub

Public Property Get Visible() As Boolean
'Return if the icon in the systray is visible
If bIconDisplayed Then
Visible = True
End If
End Property

Public Property Let Visible(ByVal bVisible As Boolean)
If bVisible Then
ShowIcon
Else
HideIcon
End If
End Property