舒宝同:怎样用VB6.0实现将窗体最小化到托盘区

来源:百度文库 编辑:神马品牌网 时间:2024/03/28 16:20:16
怎样用VB6.0实现将窗体最小化到托盘区?

忙了我一下午了!弄好了!

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的Load事件中写下如下代码:

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

'5、在Form1的QueryUnload事件中写入如下代码:

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

'6、在Form1的MouseMove事件中写下如下代码:

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就自动弹出来了。

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 Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_LButtonDown = &H204
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4

Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim t As NOTIFYICONDATA

托盘,亦即程序最小化后程序图标隐藏到屏幕右下角的任务栏里。这种最小化方法比普通的最小化节约空间,因此备受欢迎,很多软件都具有这样的功能。在VB中,可用API函数来实现托盘功能,但比较复杂,不太好操作。这里给大家介绍一种非常简单易行的方法:控件法。

COMMON\TOOLS\VB\UNSUPPRT\SYSTRAY

说到控件,大家可能要皱眉头了:去哪找呀?放心!这个控件就躺在你的VB安装盘里!不过,得处理一下:请在Tool文件夹里查找一个名叫Systray的目录,将它拷贝到硬盘,用VB打开该目录下的工程,必要的话可作些改进(如更换图标、添加功能等),然后编译成ocx控件,可以随意命名。为方便使用起见,最好编译到Windows\System目录下。好了,现在我们就可以在我们的程序中使用此控件来轻松实现托盘功能了。添加控件的方法就不用我说了吧?
该控件最主要的属性是InTray属性:设置为True时程序图标出现在任务栏右边,设置为False时从任务栏中清除图标。此外还有图标属性TrayIcon(程序出现在任务时的图标样式)、TrayTip属性(鼠标移到该图标时出现的ToolTip字样)等,都是我们所熟悉的东西,一看就知道。
该控件的重要事件是几个我们常用的鼠标事件:按下、放开、移动、双击,编程时就是利用这些事件达到在任务栏中控制程序的目的。你会发现这也是很简单的,我就不罗嗦了。
下面给个例子。运行此例,点击最小化按钮,程序界面消失,程序图标(确切地说是CsysTray控件的图标)出现在任务栏右边;点击任务栏右边的图标,程序恢复到原状。

'最小化程序到任务栏的右边
Private Sub Form_Resize()
If Me.WindowState = 1 Then '如程序为最小化则——
cSysTray1.InTray = True '隐藏到任务栏
Me.Visible = False '让程序界面不可见
End If
End Sub

'恢复程序到屏幕
Private Sub CsysTray1_MouseDown(Button As Integer, Id As Long)
Me.WindowState = 0 '程序回复到Normal状态
Me.Visible = True '从任务栏中清除图标
cSysTray1.InTray = False '令程序界面可见
End Sub