信息发布软件,b2b软件,广告发布软件

标题: 如何把VB托盘的图标整的漂亮一些呢想过没有？ [打印本页]

作者: 群发软件 时间: 2017-5-20 00:17
标题: 如何把VB托盘的图标整的漂亮一些呢想过没有？
本帖最后由群发软件于 2017-5-20 00:19 编辑

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

Attribute VB_Name = "modTray"
'-----------------------------------------
'以下为模块中的代码：
'-----------------------------------------
Option Explicit
Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu
'【VB声明】
'Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'【说明】
' 此函数发送消息到一个窗口过程
'【返回值】
' Long，依据发送的消息不同而变化
'【参数表】
' lpPrevWndFunc----- Long，原来的窗口过程地址
' HWnd-------------- Long，窗口句柄
' Msg -------------- Long，发送的消息
' wParam ----------- Long，消息类型，参考wParam参数表
' lParam ----------- Long，依据wParam参数的不同而不同
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'【VB声明】
' Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'【说明】
' 在窗口结构中为指定的窗口设置信息
'【返回值】
' Long，指定数据的前一个值
'【参数表】
' hwnd ----------- Long，欲为其取得信息的窗口的句柄
' nIndex --------- Long，请参考GetWindowLong函数的nIndex参数的说明
' dwNewLong ------ Long，由nIndex指定的窗口信息的新值
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal HWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'【VB声明】
'Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'【说明】
'【参数表】
'参数dwMessage ---- 为消息设置值，它可以是以下的几个常数值：0、1、2
'NIM_ADD = 0 加入图标到系统状态栏中
'NIM_MODIFY = 1 修改系统状态栏中的图标
'NIM_DELETE = 2 删除系统状态栏中的图标
'参数LpData ---- 用以传入NOTIFYICONDATA数据结构变量，我们也需要在"模块"中定义其结构如下：
'Type NOTIFYICONDATA
' cbSize As Long 需填入NOTIFYICONDATA数据结构的长度
' HWnd As Long 设置成窗口的句柄
' Uid As Long 为图标所设置的ID值
' Uflags As Long 用来设置以下三个参数uCallbackMessage、hIcon、szTip是否有效
' UCallbackMessage As Long 消息编号
' Hicon As Long 显示在状态栏上的图标
' SzTip As String * 64 提示信息
'End Type
'---- 其中参数uCallbackMessage、hIcon、szTip也应在模块中声明为以下的常量：
'Public Const NIF_MESSAGE = 1
'Public Const NIF_ICON = 2
'Public Const NIF_TIP = 4
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2
'记录设置托盘图标的数据的数据类型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 * 64
End Type
'TheData变量记录设置托盘图标的数据
Private TheData As NOTIFYICONDATA
' *********************************************
' 新的窗口过程--主程序中采用SetWindowLong函数改变了窗口函数的地址，消息转向由NewWindowProc处理
' *********************************************
Public Function NewWindowProc(ByVal HWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'如果用户点击了托盘中的图标，则进行判断是点击了左键还是右键
If Msg = TRAY_CALLBACK Then
      '如果点击了左键
      If lParam = WM_LBUTTONUP Then
         '而这时窗体的状态是最小化时
         If TheForm.WindowState = vbMinimized Then _
            '恢复到最小化前的窗体状态
            TheForm.WindowState = TheForm.LastState
            TheForm.SetFocus
            Exit Function
         End If
      End If
      '如果点击了右键
      If lParam = WM_RBUTTONUP Then
         '则弹出右键菜单
         TheForm.PopupMenu TheMenu
         Exit Function
      End If
End If
'如果是其他类型的消息则传递给原有默认的窗口函数
NewWindowProc = CallWindowProc(OldWindowProc, HWnd, Msg, wParam, lParam)
End Function
' *********************************************
' 把主窗体的图标（Form1.icon属性可改变）添加到托盘中
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
'保存当前窗体和菜单信息
Set TheForm = frm
Set TheMenu = mnu
'GWL_WNDPROC获得该窗口的窗口函数的地址
OldWindowProc = SetWindowLong(frm.HWnd, GWL_WNDPROC, AddressOf NewWindowProc)
'知识点滴：HWnd属性
'返回窗体或控件的句柄。语法: object.HWnd
'说明:Microsoft Windows 运行环境，通过给应用程序中的每个窗体和控件
'分配一个句柄（或 hWnd）来标识它们。hWnd 属性用于Windows API调用。
'将主窗体图标添加在托盘中
With TheData
      .Uid = 0 '忘了吗？参考一下前面内容,Uid图标的序号，做动画图标有用
      .HWnd = frm.HWnd
      .cbSize = Len(TheData)
      .Hicon = frm.Icon.Handle
      .Uflags = NIF_ICON '指明要对图标进行设置
      .UCallbackMessage = TRAY_CALLBACK
      .Uflags = .Uflags Or NIF_MESSAGE '指明要设置图标或返回信息给主窗体，此句不能省去
      .cbSize = Len(TheData) '为什么呢？我们需要在添加图标的同时，让其返回信息
End With '给主窗体，Or的意思是同时进行设置和返回消息
Shell_NotifyIcon NIM_ADD, TheData '根据前面定义NIM_ADD，设置为“添加模式”
End Sub
' *********************************************
' 删除系统托盘中的图标
' *********************************************
Public Sub RemoveFromTray()
'删除托盘中的图标
With TheData
.Uflags = 0
End With
Shell_NotifyIcon NIM_DELETE, TheData '根据前面定义NIM_DELETE，设置为“删除模式”
'恢复原有的设置
SetWindowLong TheForm.HWnd, GWL_WNDPROC, OldWindowProc
End Sub
' *********************************************
' 为托盘中的图标加上浮动提示（也就是鼠标移上去时出现的提示字条）
' *********************************************
Public Sub SetTrayTip(tip As String)
With TheData
      .SzTip = tip & vbNullChar
      .Uflags = NIF_TIP '指明要对浮动提示进行设置
End With
Shell_NotifyIcon NIM_MODIFY, TheData '根据前面定义NIM_MODIFY，设置为“修改模式”
End Sub
' *********************************************
' 设置托盘的图标（在本例中没有用到，如果要动态改变托盘内显示的图标，它非常有用）
' 例如：1、显示动画图标（方法你一定猜到了，对！使用Timer控件，不断调用此过程，注意把动画放在pic数组中）
' 2、程序处于不同状态时，显示不同的图标，方法是类似的
' 有兴趣的话试一试吧。
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
'判断一下pic中存放的是不是图标
If pic.Type <> vbPicTypeIcon Then Exit Sub
'更换图标为pic中存放的图标
With TheData
      .Hicon = pic.Handle
      .Uflags = NIF_ICON
End With
Shell_NotifyIcon NIM_MODIFY, TheData
End Sub

vb中有一个控件是可以实现你要的功能的：
需要找到VB的安装盘(不是安装以后的目录)的COMMON\TOOLS\VB\UNSUPPRT\SYSTRAY目录，将Systray目录拷到硬盘上面并编译为ocx控件（编译前记得要先把只读属性修改掉，有时候会提示要先保存，直接保存。），
　　然后在自己的VB程序中添加改控件(工程-部件-浏览)。
　　最好把这个ocx放到C:\WINDOWS\system32。
　　改控件的属性InTray属性用来设置是否显示在托盘中，True为显示在托盘，False为不显示。TrayIcon属性是在托盘中显示的图标式样。TrayTip属性是鼠标移到改控件上面显示的提示文字。如果要使程序最小化时显示到托盘，如下：
　　Private Sub Form_Resize()
　　If Me.WindowState = vbMinimized Then
　　cSysTray1.InTray = True
　　Me.Visible = FalseEnd If
　　End Sub
　　点击托盘图标后让程序显示出来，如下：
　　Private Sub cSysTray1_MouseDown(Button As Integer, Id As Long)
　　Me.WindowState = vbNormal
　　Me.Visible = True
　　cSysTray1.InTray = False
　　Me.SetFocus
　　End Sub

作者: 紫逸风 时间: 2017-5-23 04:57
很快，东西很多，不错哦

作者: yiyi2014 时间: 2017-5-23 15:17
值得好评，赞一个！！！

作者: anleeycn 时间: 2017-5-23 20:38
错的购物，客服很细心、热情，对我提的所有问题都耐心回答，一步一步教我操作，让我们能够很顺利地完成这次购物。售后培训也很耐心，以后还会来的。

作者: ye112219 时间: 2017-5-26 22:57
0多天才来评价的，后台很完美易懂。客服和助理，技师都会一一解答！！全5分星是一定的！！

作者: 429187535 时间: 2017-6-3 16:18
信誉，值得好评！

作者: jiandao1 时间: 2017-6-10 14:36
服务态度很好谢谢18号

作者: daoke 时间: 2017-6-15 22:23
心的帮助设置模板，非常满意！

欢迎光临信息发布软件,b2b软件,广告发布软件 (http://postbbs.com/)