VB源代码-程序退至托盘执行及气泡提示_免费下载.doc

本源代码是一款完整的VB托盘气泡提示模块的源代码，气泡提示在Winodws编程应用中非常普遍，可使你的程序增加人性化体验，同时美化你的程序窗体，这个气泡提示控件，用起来很方便，希望广大VB程序员喜欢。模块Option ExplicitPublic Declare Function Shell_NotifyIcon Lib shell32.dll Alias Shell_NotifyIconA (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPublic Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 128 dwState As Long dwStateMask As Long szInfo As String * 256 uTimeout As Long szInfoTitle As String * 64 dwInfoFlags As LongEnd TypePublic Const NOTIFYICON_VERSION = 3Public Const NOTIFYICON_OLDVERSION = 0Public Const NIM_ADD = &H0Public Const NIM_MODIFY = &H1Public Const NIM_DELETE = &H2Public Const NIM_SETFOCUS = &H3Public Const NIM_SETVERSION = &H4Public Const NIF_MESSAGE = &H1Public Const NIF_ICON = &H2Public Const NIF_TIP = &H4Public Const NIF_STATE = &H8Public Const NIF_INFO = &H10Public Const NIS_HIDDEN = &H1Public Const NIS_SHAREDICON = &H2Public Const NIIF_NONE = &H0Public Const NIIF_WARNING = &H2Public Const NIIF_ERROR = &H3Public Const NIIF_INFO = &H1Public Const NIIF_GUID = &H4Public myData As NOTIFYICONDATAPublic Declare Function SetWindowLong Lib user32 Alias SetWindowLongA _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPublic 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 LongPublic Declare Function GetWindowLong Lib user32 Alias GetWindowLongA (ByVal hWnd As Long, ByVal nIndex As Long) As LongPublic Const TRAY_CALLBACK = (&H400 + 1001&)Public Const GWL_WNDPROC = -4Public 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 Enum WIN_STATUS STA_MIN STA_NORMALEnd EnumPublic glWinRet As LongPublic OrgWinRet As LongPublic Status As WIN_STATUSPublic MyForm As FormPublic Function CallbackMsgs(ByVal wHwnd As Long, ByVal wMsg As Long, ByVal wp_id As Long, ByVal lp_id As Long) As LongOn Error Resume Next If wMsg = TRAY_CALLBACK Then With MyForm Select Case CLng(lp_id) Case WM_RBUTTONUP .PopupMenu .mnuTray, , , , .mnuShow Case WM_LBUTTONUP If .WindowState = vbMinimized Then .Visible = True .WindowState = vbNormal Else .WindowState = vbMinimized .Visible = False End If End Select End With End If CallbackMsgs = CallWindowProc(glWinRet, wHwnd, wMsg, wp_id, lp_id)End FunctionPublic Function ShowTip(ByVal TipTitle As String, ByVal TipContent As String, TipIco As Integer)With myData .szInfoTitle = TipTitle & vbNullChar .szInfo = TipContent & vbNullChar .dwInfoFlags = TipIco End WithShell_NotifyIcon NIM_MODIFY, myDataEnd FunctionPublic Function CreatTray(ByRef TheForm As Form, TipMove As String, TipTitle As String, TipContent As String, TipIco As Long)Set MyForm = TheFormOrgWinRet = GetWindowLong(MyForm.hWnd, GWL_WNDPROC)With myData .cbSize = Len(myData) .hWnd = MyForm.hWnd .uID = vbNull .uFlags = NIF_ICON Or NIF_TIP Or NIF_INFO Or NIF_MESSAGE .uCallbackMessage = TRAY_CALLBACK .hIcon = MyForm.Icon .szTip = TipMove & vbNullChar .dwState = 0 .dwStateMask = 0 .szInfoTitle = TipTitle & vbNullChar .szInfo = TipContent & vbNullChar .dwInfoFlags = TipIco .uTimeout = 10000End WithShell_NotifyIcon NIM_ADD, myDataglWinRet = SetWindowLong(MyForm.hWnd, GWL_WNDPROC, AddressOf CallbackMsgs)End FunctionPublic Function UnloadTray()Shell_NotifyIcon NIM_DELETE, myDataCall SetWindowLong(MyForm.hWnd, GWL_WNDPROC, OrgWinRet)End Function引用Option ExplicitPrivate Sub Form_Resize()With Me If Status = STA_NORMAL And .WindowState = vbMinimized And .Visible = True Then .Visible = False Status = STA_MIN Else Status = STA_NORMAL End IfEnd WithEnd SubPrivate Sub Form_Unload(Cancel As Integer)Call UnloadTrayEnd Su