VB窗口图表化

VB窗口图表化
2011年04月20日
　　'本模块为实现托盘图标的模块 , 他在主窗体的form_resize和 form_unload中存在,看以下例子.
　　'Private Sub Form_Resize()
　　'If Me.WindowState = vbMinimized Then
　　' If tptb.show_yes = False Then
　　' tptb.AddToTray Me, m1
　　' tptb.show_yes = True
　　' tptb.SetTrayTip "资料管理"
　　' End If
　　' Me.Hide
　　'End If
　　'If Me.WindowState = 0 Then Me.WindowState = 2
　　'End Sub
　　'Private Sub Form_Unload(Cancel As Integer)
　　' tptb.RemoveFromTray
　　'End Sub
　　Public show_yes As Boolean
　　Public OldWindowProc As Long
　　Private TheForm As Form
　　Private TheMenu As Menu
　　Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer '声明外部函数,获得鼠标按键状态
　　Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) '模拟鼠标按键的API
　　Private 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
　　Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
　　Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
　　Private Declare Function EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long
　　Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
　　(ByVal hwnd As Long, ByVal lpszOp As String, _
　　ByVal lpszFile As String, ByVal lpszParams As String, _
　　ByVal LpszDir As String, ByVal FsShowCmd As Long) _
　　As Long
　　Const SW_SHOW = 5
　　Const WM_USER = &H400
　　Const WM_RBUTTONUP = &H205
　　Const TRAY_CALLBACK = (WM_USER + 1001&)
　　Const GWL_WNDPROC = (-4)
　　Const GWL_USERDATA = (-21)
　　Const NIF_ICON = &H2
　　Const NIF_TIP = &H4
　　Const NIM_ADD = &H0
　　Const NIF_MESSAGE = &H1
　　Const NIM_MODIFY = &H1
　　Const NIM_DELETE = &H2
　　Const WM_LBUTTONDBLCLK = &H203
　　Const MOUSEEVENTF_LEFTDOWN = &H2
　　Const MOUSEEVENTF_LEFTUP = &H4
　　Const VK_LBUTTON = &H1
　　Const VK_RBUTTON = &H2
　　Const MOUSEEVENTF_RIGHTDOWN = &H8 '，模拟鼠标右键按下
　　Const MOUSEEVENTF_RIGHTUP = &H10 '，模拟鼠标右键抬起
　　Const WS_MINIMIZEBOX = &H20000
　　Const WS_MAXIMIZEBOX = &H10000
　　'记录 设置托盘图标的数据 的数据类型NOTIFYICONDATA
　　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
　　'TheData变量记录设置托盘图标的数据
　　Private TheData As NOTIFYICONDATA
　　' *********************************************
　　' 新的窗口过程--主程序中采用SetWindowLong函数改变了窗口函数的地址，消息转向由NewWindowProc处理
　　' *********************************************
　　Private 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_LBUTTONDBLCLK Then
　　TheForm.WindowState = vbMaximized
　　TheForm.Show
　　Exit Function
　　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