创建托盘【试验成功】20120909.doc

2012-09-09 实验成功，1-8 页 【包括：托盘左键、右键事件】添加两个窗体【frmMain】 、 【frmMenu】 【frmMain】 中添加控件 PicturBox 命名为 Pic1，控件 TextBox，命名 Text1 代码： Option Explicit '强制定义类型 Dim WithEvents cTrayIco As cTray ' 托盘右键单击事件 Dim WithEvents MenuFrm As frmMenu '主窗体鼠标单击事件 Dim MeHide As Boolean ' 是否已经隐藏了 '-------------判断鼠标对托盘图标的单击是【左键】 、还是【右键】 Private Sub cTrayIco_MouseClick(ByVal Button As Long, ByVal DBClick As Boolean)Select Case ButtonCase vbRightButtonIf DBClick = False ThenPopupMenu MenuFrm.mPop2End IfCase vbLeftButtonIf DBClick = True ThenCall ShowHideMeEnd IfEnd Select End Sub Private Sub Form_Load()Set cTrayIco = New cTraySet MenuFrm = New frmMenuWith cTrayIco.AddTrayIco Pic1 '用于替代的图片控件.SetTrayIcon Me.Icon.SetTrayTip Me.CaptionEnd With ' OnTop MeMe.WindowState = vbNormal End Sub'-------------退出时提示“是否确认退出” Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)If MsgBox(“您真的要退出吗？ “, vbYesNo + vbDefaultButton1, “ ！退出提示 “) = vbYes ThenEndElseCancel = TrueEnd IfEnd Sub Private Sub Form_Unload(Cancel As Integer)On Error Resume NextcTrayIco.DelTrayIcoUnload MenuFrmSet cTrayIco = NothingSet MenuFrm = Nothing End Sub Private Sub MenuFrm_MenuClick2(ByVal Index As Long)'托盘右键菜单点击事件Dim str As Stringstr = Text1.TextSelect Case IndexCase 0 ' 显示/ 隐藏界面Call ShowHideMeCase 1Case 2 '选择默认数据库If Mid(str, InStrRev(str, “\“) + 1) = “456“ Then '从字符串最右端的“\”符 号开始截取字段MsgBox “ 您正在使用默认数据库！ “, vbOKOnly, “【提示】 “End IfCase 3Case 4 '切换当前数据库Unload MeCase 5Case 6Unload MeEnd Select End Sub' Private Function ShowHideMe()'显示或隐藏主窗体On Error Resume NextIf Me.WindowState 0 ThenMe.Top = IIf(I = -1, 0, Screen.Height - TaskBarHeight - Me.Height)End IfElseMe.WindowState = vbMinimizedMe.HideEnd If End Function Private Function FormIsTop(ByVal WC_Pix As Long) As Long'窗体是否在屏幕上边或下边， ，托盘右键【隐藏、显示窗体时需要】'在上顶边,返回-1'在下边,返回 1'否则返回 0On Error Resume NextIf Me.Top Screen.Height - TaskBarHeight - frmMain.Height - WC_Pix * 15 ThenDebug.Print “Top + OK“FormIsTop = 1ElseFormIsTop = 0End If End Function 【frmMenu】 中 使用菜单编辑器 一级：mPop2 二级：显示 / 隐藏主界面 名称：mPops2 索引： 0 - 名称：mPops2 索引： 1 【- 用于扩大间隔】选择默认数据库 名称：mPops2 索引： 2- 名称：mPops2 索引： 3 【- 用于扩大间隔】切换当前数据库 名称：mPops2 索引： 4- 名称：mPops2 索引： 5 【- 用于扩大间隔】退出 名称：mPops2 索引： 6 代码： Option Explicit Public Event MenuClick(ByVal Index As Long) Public Event MenuClick2(ByVal Index As Long) Private Sub mPops2_Click(Index As Integer) ''''‘ 托盘右键RaiseEvent MenuClick2(Index) End Sub ---------------------------------------------------------------------------------------------------------------- ---------------------------------------------------------------------------------------------------------------------- 【模块】：类模块：cTray、 模块：ModGetTaskbar 、 ， 模块：ModIsIDE 类模块：cTray 代码： '************************************************************************* '**模 块 名：cTray '**说 明：设置托盘图标 '**创 建 人： '************************************************************************* Option Explicit Private Const WM_MOUSEFIRST = &H200 Private Const WM_MOUSEMOVE = &H200 Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Private Const WM_LBUTTONDBLCLK = &H203 Private Const WM_RBUTTONDOWN = &H204 Private Const WM_RBUTTONUP = &H205 Private Const WM_RBUTTONDBLCLK = &H206 Private Const WM_MBUTTONDOWN = &H207Private Const WM_MBUTTONUP = &H208 Private Const WM_MBUTTONDBLCLK = &H209 Private Const WM_MOUSELAST = &H209 Private Const WM_USER = &H400 Private Const TRAY_CALLBACK = (WM_USER + 1001&) Private Const NIF_ICON = &H2 Private Const NIF_TIP = &H4 Private Const NIM_ADD = &H0 Private Const NIF_MESSAGE = &H1 Private Const NIM_MODIFY = &H1 Private Const NIM_DELETE = &H2 Private Const PM_REMOVE = &H1 Private Const PM_NOREMOVE = &H0 Private Type NOTIFYICONDATAcbSize As LonghWnd As LonguID As LonguFlags As LonguCallbackMessage As LonghIcon As LongszTip As String * 64 End Type Private Type POINTAPIx As Longy As Long End Type Private Type MsghWnd As LongMessage As LongwParam As LonglParam As Longtime As Longpt As POINTAPI End Type Private Declare Function Shell_NotifyIcon Lib “shell32.dll“ Alias “Shell_NotifyIconA“ (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long Private TheData As NOTIFYICONDATA Public Event MouseClick(ByVal Button As Long, ByVal DBClick As Boolean) Dim WithEvents cPic As PictureBox。