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

VB6如何在托盘中写入应用程序图标1、新建立一个VB6工程，将Form1的ShowInTaskBar属性设置为False2、菜单：工程-添加模块 按“打开”这样就添加了一个新模块，名为Module1,保存为Module1.bas3、在Module1中写下如下代码： Option ExplicitPublic Const MAX_TOOLTIP As Integer = 64Public Const NIF_ICON = &H2Public Const NIF_MESSAGE = &H1Public Const NIF_TIP = &H4Public Const NIM_ADD = &H0Public Const NIM_DELETE = &H2Public Const WM_MOUSEMOVE = &H200Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_LBUTTONDBLCLK = &H203Public Const WM_RBUTTONDOWN = &H204Public Const WM_RBUTTONUP = &H205Public Const WM_RBUTTONDBLCLK = &H206Public Const SW_RESTORE = 9Public Const SW_HIDE = 0Public nfIconData As NOTIFYICONDATAPublic Type NOTIFYICONDATAcbSize As LonghWnd As LonguID As LonguFlags As LonguCallbackMessage As LonghIcon As LongszTip As String * MAX_TOOLTIPEnd TypePublic Declare Function ShowWindow Lib user32 (ByVal hWnd As Long, ByVal nCmdShow As Long) As LongPublic Declare Function Shell_NotifyIcon Lib shell32.dll Alias Shell_NotifyIconA (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long4、在Form1的Load事件中写下如下代码：Private Sub Form_Load()以下把程序放入System Tray=System Tray BeginWith 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 WithCall Shell_NotifyIcon(NIM_ADD, nfIconData)=System Tray EndMe.HideEnd Sub5、在Form1的QueryUnload事件中写入如下代码：Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)Call Shell_NotifyIcon(NIM_DELETE, nfIconData)End Sub6、在Form1的MouseMove事件中写下如下代码：Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Dim lMsg As SinglelMsg = X / Screen.TwipsPerPixelXSelect Case lMsgCase WM_LBUTTONUPMsgBox 请用鼠标右键点击图标!, vbInformation, 实时播音专家单击左键，显示窗体ShowWindow Me.hWnd, SW_RESTORE下面两句的目的是把窗口显示在窗口最顶层Me.ShowMe.SetFocus Case WM_RBUTTONUP PopupMenu MenuTray 如果是在系统Tray图标上点右键，则弹出菜单MenuTray Case WM_MOUSEMOVE Case WM_LBUTTONDOWN Case WM_LBUTTONDBLCLK Case WM_RBUTTONDOWN Case WM_RBUTTONDBLCLK Case ElseEnd SelectEnd Sub7、现在将程序保存起来运行看看系统托盘处是否增加了一个本工程的图标。单击此图标，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。图3Timer控件属性页的设置如图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 IntegerPrivate Sub Form_Load()Timer1.Enabled = True2个垂直显示的进度条的位置With ccrpProgressBar8.Left = 5280.Top = 360.Height = 3800.Width = 396End WithWith ccrpProgressBar9.Left = 6200.Top = 360.Height = 3800.Width = 396End WithEnd SubPrivate Sub Timer1_Timer()If i = 100 ThenEndEnd IfccrpProgressBar1.Value = iccrpProgressBar2.Value = iccrpProgressBar3.Value = iccrpProgressBar4.Value = iccrpProgressBar5.Value = iccrpProgressBar6.Value = iccrpProgressBar7.Value = iccrpProgressBar8.Value = iccrpProgressBar9.Value = ii = i + 1 变量i自增End Sub运行程序，运行中的效果如图5所示。用VB打造“超酷”个性化菜单众所周知，MS Office 2003推出已经有一段时间了，但我们依然不会忘记Office XP刚刚推出时其令人耳目一新的菜单给我们留下的深刻印象。突起的悬浮式图标，不同寻常的菜单项填充方式，不仅让办公一族们赞不绝口，更让广大的程序员和编程爱好者对这种风格的菜单的制作产生了浓厚的兴趣。所以，在这篇文章里，我们就来好好地研究研究用VB怎么制作这种风格的菜单，在文章的最后，我将给出源代码的下载地址。事实上，在了解其原理以后，不论是用VB、VC还是Delphi，都能够制作出XP风格的菜单。不仅如此，我们还可以制作出更加充满个性的另类风格的菜单，比如3D立体风格、渐变风格、多彩风格等等。只有想不到的，没有做不到的。Follow me！ 现在，我想有必要说一说我们现在要做的事情。事实上，我们只要做一个菜单类就行了。但谁都会明白，只做一个菜单类是不够的，我们需要一个程序，或者更详细的说，是一个窗体，来测试我们的菜单类。在我个人的开发过程中，我是先写的菜单类，后写的测试窗体，但为了让大家先领略一下写好的菜单类在应用时是多么的方便，所以让我们先来看看测试窗体：（1）打开VB，新建“标准EXE”工程。（2）-下面是窗体的控件：组件名称属性值FormNamefrmMainCaption菜单例子FrameNamefraStyleCaption菜单风格LabelNamelblHelpCaption在窗体空白处单击鼠标右键OptionButtonNameopnStyleCaptionWindow 标准Index0OptionButtonNameopnStyleCaptionXP 风格Index1OptionButtonNameopnStyleCaption3D 立体风格Index2OptionButtonNameopnStyleCaption渐变风格Index3OptionButtonNameopnStyleCaption多彩风格Index4其实就是在窗体上添加了一个Frame，然后在Frame里添加OptionButton控件数组，用来设置菜单风格，还有一个Label，上面只显示一行提示文字，非常简单。（3）窗体代码：Option ExplicitPrivate Declare Function GetCursorPos Lib user32.dll (lpPoint As POINTAPI) As LongPrivate Type POINTAPIX As LongY As LongEnd TypeDim menu As cMenuPrivate Sub Form_Load() 初始化菜单并添加菜单项Set menu = New cMenumenu.CreateMenumenu.AddItem open, LoadPicture(imagesopen.ico), 打开, MIT_STRINGmenu.AddItem save, LoadPicture(imagessave.ico), 保存, MIT_STRINGmenu.AddItem print, LoadPicture(imagesprint.ico), 打印, MIT_STRINGmenu.AddItem find, LoadPicture(imagesfind.ico), 查找, MIT_STRINGmenu.AddItem sep1, LoadPicture(), , MIT_SEPARATORmenu.AddItem undo, LoadPicture(imagesundo.ico), 撤消, MIT_STRINGmenu.AddItem redo, LoadPicture(imagesredo.ico), 重复, MIT_STRINGmenu.AddItem sep2, LoadPicture(), , MIT_SEPARATORmenu.AddItem cut, LoadPicture(imagescut.ico), 剪切, MIT_STRINGmenu.AddItem copy, LoadPicture(imagescopy.ico), 复制, MIT_STRINGmenu.AddItem paste, LoadPicture(imagespaste.ico), 粘贴, MIT_STRINGmenu.AddItem sep3, LoadPicture(), , MIT_SEPARATORmenu.AddItem check, LoadPicture(imagescheck.ico), 一个 CheckBox, MIT_CHECKBOXmenu.AddItem exit, LoadPicture(imagesexit.ico), 退出, MIT_STRINGEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 单击鼠标右建弹出菜单If Button = vbRightButton ThenDim pos As POINTAPIGetCursorPos posmenu.PopupMenu pos.X, pos.Y, POPUP_LEFTALIGN Or POPUP_TOPALIGNEnd IfEnd SubPrivate Sub Form_Unload(Cancel As Integer) 释放资源, 卸载窗体Set menu = NothingDim frm As FormFor Each frm In FormsUnload frmNextEnd SubPrivate Sub opnStyle_Click(Index As Integer) 设置菜单风格Select Case IndexCase 0 Windows 标准menu.Style = STYLE_WINDOWSCase 1 XP 风格menu.Style = STYLE_XPCase 2 3D 立体风格menu.Style = STYLE_3DCase 3 渐变风格menu.Style = STYLE_SHADECase 4 多彩风格menu.Style = STYLE_COLORFULEnd SelectEnd 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 ExplicitPrivate 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 LongPublic Enum MenuUserStyle 菜单总体风格STYLE_WINDOWSSTYLE_XPSTYLE_SHADESTYLE_3DSTYLE_COLORFULEnd EnumPublic Enum MenuSeparatorStyle 菜单分隔条风格MSS_SOLIDMSS_DASHMSS_DOTMSS_DASDOTMSS_DASHDOTDOTMSS_NONEMSS_DEFAULTEnd EnumPublic Enum MenuItemSelectFillStyle 菜单项背景填充风格ISFS_NONEISFS_SOLIDCOLORISFS_HORIZONTALCOLORISFS_VERTICALCOLOREnd EnumPublic Enum MenuItemSelectEdgeStyle 菜单项边框风格ISES_SOLIDISES_DASHISES_DOTISES_DASDOTISES_DASHDOTDOTISES_NONEISES_SUNKENISES_RAISEDEnd EnumPublic Enum MenuItemIconStyle 菜单项图标风格IIS_NONEIIS_SUNKENIIS_RAISEDIIS_SHADOWEnd EnumPublic Enum MenuItemSelectScope 菜单项高亮条的范围ISS_TEXT = &H1ISS_ICON_TEXT = &H2ISS_LEFTBAR_ICON_TEXT = &H4End EnumPublic Enum MenuLeftBarStyle 菜单附加条风格LBS_NONELBS_SOLIDCOLORLBS_HORIZONTALCOLORLBS_VERTICALCOLORLBS_IMAGEEnd EnumPublic Enum MenuItemType 菜单项类型MIT_STRING = &H0MIT_CHECKBOX = &H200MIT_SEPARATOR = &H800End EnumPublic Enum MenuItemState 菜单项状态MIS_ENABLED = &H0MIS_DISABLED = &H2MIS_CHECKED = &H8MIS_UNCHECKED = &H0End EnumPublic 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, preMenuWndProcErase MyItemInfoDestroyMenu hMenuEnd Sub 创建弹出式菜单Public Sub CreateMenu()preMenuWndProc = SetWindowLong(frmMenu.hwnd, GWL_WNDPROC, AddressOf MenuWndProc)hMenu = CreatePopupMenu()Me.Style = STYLE_WINDOWSEnd 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 LongDim 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 = itemTextEnd WithInsertMenuItem hMenu, ID, False, ItemInfo 将菜单项数据存入动态数组ReDim Preserve MyItemInfo(ID) As MyMenuItemInfoFor i = 0 To UBound(MyItemInfo)If MyItemInfo(i).itemAlias = itemAlias ThenClass_TerminateErr.Raise vbObjectError + 513, cMenu, 菜单项别名相同.End IfNext iWith MyItemInfo(ID)Set .itemIcon = itemIcon.itemText = itemText.itemType = itemType.itemState = itemState.itemAlias = itemAliasEnd With 获得菜单项数据With ItemInfo.cbSize = LenB(ItemInfo).fMask = MIIM_DATA Or MIIM_ID Or MIIM_TYPEEnd WithGetMenuItemInfo hMenu, ID, False, ItemInfo 设置菜单项数据With ItemInfo.fMask = .fMask Or MIIM_TYPE.fType = MFT_OWNERDRAWEnd WithSetMenuItemInfo hMenu, ID, False, ItemInfo 菜单项ID累加ID = ID + 1End Sub 删除菜单项Public Sub DeleteItem(ByVal itemAlias As String)Dim i As LongFor i = 0 To UBound(MyItemInfo)If MyItemInfo(i).itemAlias = itemAlias ThenDeleteMenu hMenu, i, 0Exit ForEnd IfNext iEnd 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 0End Sub 设置菜单项图标Public Sub SetItemIcon(ByVal itemAlias As String, ByVal itemIcon As StdPicture)Dim i As LongFor i = 0 To UBound(MyItemInfo)If MyItemInfo(i).itemAlias = itemAlias ThenSet MyItemInfo(i).itemIcon = itemIconExit ForEnd IfNext iEnd Sub 获得菜单项图标Public Function GetItemIcon(ByVal itemAlias As String) As StdPictureDim i As LongFor i = 0 To UBound(MyItemInfo)If MyItemInfo(i).itemAlias = itemAlias ThenSet GetItemIcon = MyItemInfo(i).itemIconExit ForEnd IfNext iEnd Function 设置菜单项文字Public Sub SetItemText(ByVal itemAlias As String, ByVal itemText As String)Dim i As LongFor i = 0 To UBound(MyItemInfo)If MyItemInfo(i).itemAlias = itemAlias ThenMyItemInfo(i).itemText = itemTextExit ForEnd IfNext iEnd Sub 获得菜单项文字Public Function GetItemText(ByVal itemAlias As String) As StringDim i As LongFor i = 0 To UBound(MyItemInfo)If MyItemInfo(i).itemAlias = itemAlias ThenGetItemText = MyItemInfo(i).itemTextExit ForEnd IfNext iEnd Function 设置菜单项状态 Public Sub SetItemState(ByVal itemAlias As String, ByVal itemState As MenuItemState)Dim i As LongFor i = 0 To UBound(MyItemInfo)If MyItemInfo(i).itemAlias = itemAlias ThenMyItemInfo(i).itemState = itemStateDim ItemInfo As MENUITEMINFOWith ItemInfo.cbSize = Len(ItemInfo).fMask = MIIM_STRING Or MIIM_FTYPE Or MIIM_STATE Or MIIM_SUBMENU Or MIIM_ID Or MIIM_DATAEnd WithGetMenuItemInfo hMenu, i, False, ItemInfoWith ItemInfo.fState = .fState Or itemStateEnd WithSetMenuItemInfo hMenu, i, False, ItemInfoExit For