VB6如何在托盘中写入应用程序图标.doc

VB6如何在托盘中写入应用程序图标

　　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 + "(版本 " & AppMajor & "." & 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就自动弹出来了。
将个性化进行到底 VB中打造个性进度条
2005-03-26 13:28作者：伍学慧出处：天极网责任编辑：方舟
　　控件下载

　　简介

　　VB的第三方控件ccrpProgressBar是一个进度条的控件，可以有多种形态供选择。比起VB 中自带的进度条控件ProgressBar更有个性。

　　使用实例:

　　用ccrpProgressBar制作各式各样的进度条

　　在VB中自带了一个进度条控件ProgressBar，但功能简单。我向大家推荐一个VB的第三方进度条控件ccrpProgressBar。该控件功能强大，有多种形态供选择，而且只需要简单的设置控件的属性就能实现,非常的好用。下面通过一个例子向大家介绍该控件的用法。

　　（1） 加载控件

　　启动Visual Basic 6.0，创建一个工程并保存为"工程1.vbp"，同时产生一个名为"Form1"的窗口。在工具箱的空白处单击鼠标右键，从弹出的快捷菜单中启动"部件"窗口，如图1所示。

图1

　　点击"浏览"按钮，从存放ccrpProgressBar控件的文件夹中找到ccrpprg.ocx文件。

　　点击"应用"后ccrpProgressBar控件就添加到工具箱中。如图2。

图2

　　（2） 设计窗体和控件

　　向窗体中添加9个ccrpProgressBar控件和一个Timer控件。如图3。

图3

　　Timer控件属性页的设置如图4所示。Interval的值设置为100，与ccrpProgressBar控件的默认值一致。Enabled设置为False。

图4

　　（3） ccrpProgressBar控件的主要属性

　　·Max:最大值。默认100。
　　·Min:最小值。默认0。
　　·Value:进度条的当前值。
　　·Alignment：显示表示进度的文字的位置。分别为vbCenter（中间），vbLeftJustify（左边），vbRightJustify（右边）。
　　·Appearance：进度条的3种外观。分别为prgFlat（平面），prg3D（立体） prg3Draised（立体凸起）。
　　·BackColor：进度条的背景色。
　　·FillColor：进度条的颜色。
　　·ForeColor：表示进度文字的字体颜色。
　　·Picture：进度条可用图片表示进度，从这里选择需要的图片。
　　·Shape：进度条的形状。有prgRectangle(默认)，prgEllipse和prgRoundedRect三种。
　　·Smooth： 是否平滑显示进度。True为平滑显示进度。
　　·Vertical：是否垂直显示进度条。True为垂直显示。
　　·Style：进度条的风格。当选ChkGraphical时为用图片表示进度。
　　·AutoCaption：表示进度的"文字提示"所采用的表现形式。CcrpPercentage为百分比的形式，ccrpValueOfMax为类似 1 of 100 的表现形式。Value为数字的表现形式。

　　（4）本例中ccrpProgressBar控件属性的具体设置

　　本例中共使用了9个ccrpProgressBar控件，每个ccrpProgressBar控件的具体设置如下：

　　1. CcrpProgressBar1：保持属性各项不变。

　　2. CcrpProgressBar2：Appearance的值设置为prg3D（表示用立体外观）。

　　3. CcrpProgressBar3：Appearance的值设置为prg3Draised（立体凸起），AutoCaption设为ccrpPercentage（百分比的形式表示进度），Alignment设为vbLeftJustify（表示进度的文字靠左）。

　　4. CcrpProgressBar4：BorderStyle设置为ccrpFixedSingle，AutoCaption设为ccrpPercentage（百分比的形式表示进度），Alignment设置为vbCenter（表示进度的文字在中间）

　　5. CcrpProgressBar5：Style设置为chkGraphical（用图片来表示进度）。单击"Picture"属性，选择你准备好的图片。同样，AutoCaption也设为百分比的形式表示进度，不过这次Alignment的值设置为vbRightJustify（进度文字靠右）。

　　6. CcrpProgressBar6：Shape设置为prgEllipse（椭圆型），AutoCaption设为ccrpValueOfMax（文字以类似 1 of 100 的表现形式）

　　7. CcrpProgressBar7：Shape设置为prgRoundedRect（圆角矩形），AutoCaption设为ccrpValue（数字形式）。

　　8. CcrpProgressBar8：Vertical设置为True,表示垂直显示进度条。Smooth设置为True，表示平滑显示进度。

　　9. CcrpProgressBar9：Vertical属性同8的设置，不过这回给它加上百分比显示, AutoCaption设为ccrpPercentage。

　　然后再分别调整好9个CcrpProgressBar控件的FillColor和ForeColor属性，搭配好颜色。使界面更协调。

　　（5）编写代码

　　设置好控件的属性后，在程序中加入以下代码，完成进度条的功能。
Dim i As Integer
Private Sub Form_Load()
　Timer1.Enabled = True
　'2个垂直显示的进度条的位置
　With ccrpProgressBar8
　　.Left = 5280
　　.Top = 360
　　.Height = 3800
　　.Width = 396
　End With
　With ccrpProgressBar9
　　.Left = 6200
　　.Top = 360
　　.Height = 3800
　　.Width = 396
　End With
End Sub

Private Sub Timer1_Timer()
　If i = 100 Then
　　End
　End If

　ccrpProgressBar1.Value = i
　ccrpProgressBar2.Value = i
　ccrpProgressBar3.Value = i
　ccrpProgressBar4.Value = i
　ccrpProgressBar5.Value = i
　ccrpProgressBar6.Value = i
　ccrpProgressBar7.Value = i
　ccrpProgressBar8.Value = i
　ccrpProgressBar9.Value = i

　i = i + 1 '变量i自增
End Sub

　　运行程序，运行中的效果如图5所示。

用VB打造“超酷”个性化菜单

　　众所周知，MS Office 2003推出已经有一段时间了，但我们依然不会忘记Office XP刚刚推出时其令人耳目一新的菜单给我们留下的深刻印象。突起的悬浮式图标，不同寻常的菜单项填充方式，不仅让办公一族们赞不绝口，更让广大的程序员和编程爱好者对这种风格的菜单的制作产生了浓厚的兴趣。所以，在这篇文章里，我们就来好好地研究研究用VB怎么制作这种风格的菜单，在文章的最后，我将给出源代码的下载地址。事实上，在了解其原理以后，不论是用VB、VC还是Delphi，都能够制作出XP风格的菜单。不仅如此，我们还可以制作出更加充满个性的另类风格的菜单，比如3D立体风格、渐变风格、多彩风格等等。只有想不到的，没有做不到的。Follow me！

　　现在，我想有必要说一说我们现在要做的事情。事实上，我们只要做一个菜单类就行了。但谁都会明白，只做一个菜单类是不够的，我们需要一个程序，或者更详细的说，是一个窗体，来测试我们的菜单类。在我个人的开发过程中，我是先写的菜单类，后写的测试窗体，但为了让大家先领略一下写好的菜单类在应用时是多么的方便，所以让我们先来看看测试窗体：

　　（1）打开VB，新建“标准EXE”工程。

　　（2）--下面是窗体的控件：
组件名称
属性
值
Form
Name
frmMain
Caption
菜单例子
Frame
Name
fraStyle
Caption
菜单风格
Label
Name
lblHelp
Caption
在窗体空白处单击鼠标右键
OptionButton
Name
opnStyle
Caption
Window 标准
Index
0
OptionButton
Name
opnStyle
Caption
XP 风格
Index
1
OptionButton
Name
opnStyle
Caption
3D 立体风格
Index
2
OptionButton
Name
opnStyle
Caption
渐变风格
Index
3
OptionButton
Name
opnStyle
Caption
多彩风格
Index
4

　　其实就是在窗体上添加了一个Frame，然后在Frame里添加OptionButton控件数组，用来设置菜单风格，还有一个Label，上面只显示一行提示文字，非常简单。

　　（3）窗体代码：
Option Explicit

Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
　X As Long
　Y As Long
End Type

Dim menu As cMenu

Private Sub Form_Load()

　' 初始化菜单并添加菜单项

　Set menu = New cMenu
　menu.CreateMenu
　menu.AddItem "open", LoadPicture("images\open.ico"), "打开", MIT_STRING
　menu.AddItem "save", LoadPicture("images\save.ico"), "保存", MIT_STRING
　menu.AddItem "print", LoadPicture("images\print.ico"), "打印", MIT_STRING
　menu.AddItem "find", LoadPicture("images\find.ico"), "查找", MIT_STRING
　menu.AddItem "sep1", LoadPicture(), "", MIT_SEPARATOR
　menu.AddItem "undo", LoadPicture("images\undo.ico"), "撤消", MIT_STRING
　menu.AddItem "redo", LoadPicture("images\redoico"), "重复", MIT_STRING
　menu.AddItem "sep2", LoadPicture(), "", MIT_SEPARATOR
　menu.AddItem "cut", LoadPicture("images\cut.ico"), "剪切", MIT_STRING
　menu.AddItem "copy", LoadPicture("images\copy.ico"), "复制", MIT_STRING
　menu.AddItem "paste", LoadPicture("images\paste.ico"), "粘贴", MIT_STRING
　menu.AddItem "sep3", LoadPicture(), "", MIT_SEPARATOR
　menu.AddItem "check", LoadPicture("images\check.ico"), "一个 CheckBox", MIT_CHECKBOX
　menu.AddItem "exit", LoadPicture("images\exit.ico"), "退出", MIT_STRING

End Sub

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

　' 单击鼠标右建弹出菜单
　If Button = vbRightButton Then
　　Dim pos As POINTAPI
　　GetCursorPos pos
　　menu.PopupMenu pos.X, pos.Y, POPUP_LEFTALIGN Or POPUP_TOPALIGN
　End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
　' 释放资源, 卸载窗体
　Set menu = Nothing
　Dim frm As Form
　For Each frm In Forms
　　Unload frm
　Next
End Sub

Private Sub opnStyle_Click(Index As Integer)

　' 设置菜单风格

　Select Case Index
　　Case 0 ' Windows 标准
　　　menu.Style = STYLE_WINDOWS
　　Case 1 ' XP 风格
　　　menu.Style = STYLE_XP
　　Case 2 ' 3D 立体风格
　　　menu.Style = STYLE_3D
　　Case 3 ' 渐变风格
　　　menu.Style = STYLE_SHADE
　　Case 4 ' 多彩风格
　　　menu.Style = STYLE_COLORFUL
　End Select

End Sub

　　代码中创建了一个cMenu类的对象，我们的编程重点将会放在cMenu类上，上面的代码只是简单地调用cMenu。在后面的文章中，我们会看到其实cMenu有多达30个方法和属性供我们调用，它的Style属性只提供了5种内置风格，在实际应用中，我们可以利用cMenu类提供的方法和属性制作出各种各样风格的菜单，为自己的程序锦上添花。

　　（4）运行结果：

　　　　　　　　图1

　　　　　　　　　图2

　　　　　　　　　图3

　　　　　　　　　图4

　　　　　　　　　图5

　　下面我们来创建接收消息的窗体：打开上面建好的工程，添加一个窗体，并将其名称设置为frmMenu（注意：这一步是必须的）。图5菜单左边那个黑底色的附加条，为了方便，将frmMenu的Picture属性设置成图5。到此，这个窗体就算OK了！对了，就这样，因为这个窗体仅仅是为了处理消息和存储那个黑底色的风格条，我们将会对它进行子类处理，处理消息的代码全部都放在了将在下面详细介绍的标准模块中。

　　接下来添加一个类模块，并将其名称设置为cMenu，代码如下：

'***************************************************************
'* 本类模块是一个菜单类, 提供了各种样式的菜单的制作方案
'*
'* 版权: LPP软件工作室
'* 作者: 卢培培(goodname008)
'* (******* 复制请保留以上信息 *******)
'*********************************************************************

Option Explicit

Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As Any) As Long

Public Enum MenuUserStyle ' 菜单总体风格
　STYLE_WINDOWS
　STYLE_XP
　STYLE_SHADE
　STYLE_3D
　STYLE_COLORFUL
End Enum

Public Enum MenuSeparatorStyle ' 菜单分隔条风格
　MSS_SOLID
　MSS_DASH
　MSS_DOT
　MSS_DASDOT
　MSS_DASHDOTDOT
　MSS_NONE
　MSS_DEFAULT
End Enum

Public Enum MenuItemSelectFillStyle ' 菜单项背景填充风格
　ISFS_NONE
　ISFS_SOLIDCOLOR
　ISFS_HORIZONTALCOLOR
　ISFS_VERTICALCOLOR
End Enum

Public Enum MenuItemSelectEdgeStyle ' 菜单项边框风格
　ISES_SOLID
　ISES_DASH
　ISES_DOT
　ISES_DASDOT
　ISES_DASHDOTDOT
　ISES_NONE
　ISES_SUNKEN
　ISES_RAISED
End Enum

Public Enum MenuItemIconStyle ' 菜单项图标风格
　IIS_NONE
　IIS_SUNKEN
　IIS_RAISED
　IIS_SHADOW
End Enum

Public Enum MenuItemSelectScope ' 菜单项高亮条的范围
　ISS_TEXT = &H1
　ISS_ICON_TEXT = &H2
　ISS_LEFTBAR_ICON_TEXT = &H4
End Enum

Public Enum MenuLeftBarStyle ' 菜单附加条风格
　LBS_NONE
　LBS_SOLIDCOLOR
　LBS_HORIZONTALCOLOR
　LBS_VERTICALCOLOR
　LBS_IMAGE
End Enum

Public Enum MenuItemType ' 菜单项类型
　MIT_STRING = &H0
　MIT_CHECKBOX = &H200
　MIT_SEPARATOR = &H800
End Enum

Public Enum MenuItemState ' 菜单项状态
　MIS_ENABLED = &H0
　MIS_DISABLED = &H2
　MIS_CHECKED = &H8
　MIS_UNCHECKED = &H0
End Enum

Public Enum PopupAlign ' 菜单弹出对齐方式
　POPUP_LEFTALIGN = &H0& ' 水平左对齐
　POPUP_CENTERALIGN = &H4& ' 水平居中对齐
　POPUP_RIGHTALIGN = &H8& ' 水平右对齐
　POPUP_TOPALIGN = &H0& ' 垂直上对齐
　POPUP_VCENTERALIGN = &H10& ' 垂直居中对齐
　POPUP_BOTTOMALIGN = &H20& ' 垂直下对齐
End Enum

' 释放类

Private Sub Class_Terminate()
　SetWindowLong frmMenu.hwnd, GWL_WNDPROC, preMenuWndProc
　Erase MyItemInfo
　DestroyMenu hMenu
End Sub

' 创建弹出式菜单

Public Sub CreateMenu()
　preMenuWndProc = SetWindowLong(frmMenu.hwnd, GWL_WNDPROC, AddressOf MenuWndProc)
　hMenu = CreatePopupMenu()
　Me.Style = STYLE_WINDOWS
End Sub

' 插入菜单项并保存自定义菜单项数组, 设置Owner_Draw自绘菜单

Public Sub AddItem(ByVal itemAlias As String, ByVal itemIcon As StdPicture,
　　ByVal itemText As String, ByVal itemType As MenuItemType,
　　Optional ByVal itemState As MenuItemState)

　Static ID As Long, i As Long
　Dim ItemInfo As MENUITEMINFO
　' 插入菜单项
　With ItemInfo
　　.cbSize = LenB(ItemInfo)
　　.fMask = MIIM_STRING Or MIIM_FTYPE Or MIIM_STATE Or MIIM_SUBMENU Or MIIM_ID Or MIIM_DATA

　　.fType = itemType
　　.fState = itemState
　　.wID = ID
　　.dwItemData = True
　　.cch = lstrlen(itemText)
　　.dwTypeData = itemText
　End With

　InsertMenuItem hMenu, ID, False, ItemInfo

　' 将菜单项数据存入动态数组

　ReDim Preserve MyItemInfo(ID) As MyMenuItemInfo
　For i = 0 To UBound(MyItemInfo)
　　If MyItemInfo(i).itemAlias = itemAlias Then
　　　Class_Terminate
　　　Err.Raise vbObjectError + 513, "cMenu", "菜单项别名相同."
　　End If
　Next i

　With MyItemInfo(ID)
　　Set .itemIcon = itemIcon
　　.itemText = itemText
　　.itemType = itemType
　　.itemState = itemState
　　.itemAlias = itemAlias
　End With

　' 获得菜单项数据

　With ItemInfo
　　.cbSize = LenB(ItemInfo)
　　.fMask = MIIM_DATA Or MIIM_ID Or MIIM_TYPE
　End With

　GetMenuItemInfo hMenu, ID, False, ItemInfo

　' 设置菜单项数据

　With ItemInfo
　　.fMask = .fMask Or MIIM_TYPE
　　.fType = MFT_OWNERDRAW
　End With

　SetMenuItemInfo hMenu, ID, False, ItemInfo

　' 菜单项ID累加
　ID = ID + 1
End Sub

' 删除菜单项

Public Sub DeleteItem(ByVal itemAlias As String)
　Dim i As Long
　For i = 0 To UBound(MyItemInfo)
　　If MyItemInfo(i).itemAlias = itemAlias Then
　　　DeleteMenu hMenu, i, 0
　　　Exit For
　　End If
　Next i

End Sub

' 弹出菜单

Public Sub PopupMenu(ByVal x As Long, ByVal y As Long, ByVal Align As PopupAlign)
　TrackPopupMenu hMenu, Align, x, y, 0, frmMenu.hwnd, ByVal 0
End Sub

' 设置菜单项图标

Public Sub SetItemIcon(ByVal itemAlias As String, ByVal itemIcon As StdPicture)

　Dim i As Long
　For i = 0 To UBound(MyItemInfo)
　　If MyItemInfo(i).itemAlias = itemAlias Then
　　　Set MyItemInfo(i).itemIcon = itemIcon
　　　Exit For
　　End If
　Next i

End Sub

' 获得菜单项图标

Public Function GetItemIcon(ByVal itemAlias As String) As StdPicture

　Dim i As Long
　For i = 0 To UBound(MyItemInfo)
　　If MyItemInfo(i).itemAlias = itemAlias Then
　　　Set GetItemIcon = MyItemInfo(i).itemIcon
　　　Exit For
　　End If
　Next i
End Function

' 设置菜单项文字

Public Sub SetItemText(ByVal itemAlias As String, ByVal itemText As String)

　Dim i As Long
　For i = 0 To UBound(MyItemInfo)
　　If MyItemInfo(i).itemAlias = itemAlias Then
　　　MyItemInfo(i).itemText = itemText
　　　Exit For
　　End If
　Next i
End Sub

' 获得菜单项文字

Public Function GetItemText(ByVal itemAlias As String) As String

　Dim i As Long
　For i = 0 To UBound(MyItemInfo)
　　If MyItemInfo(i).itemAlias = itemAlias Then
　　　GetItemText = MyItemInfo(i).itemText
　　　Exit For
　　End If
　Next i

End Function

' 设置菜单项状态
Public Sub SetItemState(ByVal itemAlias As String, ByVal itemState As MenuItemState)

　Dim i As Long
　For i = 0 To UBound(MyItemInfo)
　　If MyItemInfo(i).itemAlias = itemAlias Then
　　　MyItemInfo(i).itemState = itemState
　　　Dim ItemInfo As MENUITEMINFO
　　　With ItemInfo
　　　　.cbSize = Len(ItemInfo)
　　　　.fMask = MIIM_STRING Or MIIM_FTYPE Or MIIM_STATE Or MIIM_SUBMENU Or MIIM_ID Or MIIM_DATA

　　　End With
　　　GetMenuItemInfo hMenu, i, False, ItemInfo
　　　With ItemInfo
　　　　.fState = .fState Or itemState
　　　End With
　　　SetMenuItemInfo hMenu, i, False, ItemInfo
　　　Exit For