创建托盘【试验成功】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 Button Case vbRightButton If DBClick = False Then PopupMenu MenuFrm.mPop2 End If Case vbLeftButton If DBClick = True Then Call ShowHideMe End If End SelectEnd SubPrivate Sub Form_Load() Set cTrayIco = New cTray Set MenuFrm = New frmMenu With cTrayIco .AddTrayIco Pic1 用于替代的图片控件 .SetTrayIcon Me.Icon .SetTrayTip Me.Caption End With OnTop Me Me.WindowState = vbNormalEnd Sub-退出时提示“是否确认退出”Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) If MsgBox(您真的要退出吗？ , vbYesNo + vbDefaultButton1, ！退出提示 ) = vbYes Then End Else Cancel = True End If End SubPrivate Sub Form_Unload(Cancel As Integer) On Error Resume Next cTrayIco.DelTrayIco Unload MenuFrm Set cTrayIco = Nothing Set MenuFrm = NothingEnd SubPrivate Sub MenuFrm_MenuClick2(ByVal Index As Long) 托盘右键菜单点击事件 Dim str As String str = Text1.Text Select Case Index Case 0 显示/隐藏界面 Call ShowHideMe Case 1 Case 2 选择默认数据库 If Mid(str, InStrRev(str, ) + 1) = 456 Then 从字符串最右端的“”符号开始截取字段 MsgBox 您正在使用默认数据库！ , vbOKOnly, 【提示】 End If Case 3 Case 4 切换当前数据库 Unload Me Case 5 Case 6 Unload Me End SelectEnd SubPrivate Function ShowHideMe() 显示或隐藏主窗体 On Error Resume Next If Me.WindowState vbNormal Then Dim I As Long Me.WindowState = vbNormal Me.Show timerAutoHide.Enabled = False I = FormIsTop(5) If I 0 Then Me.Top = IIf(I = -1, 0, Screen.Height - TaskBarHeight - Me.Height) End If Else Me.WindowState = vbMinimized Me.Hide End IfEnd FunctionPrivate Function FormIsTop(ByVal WC_Pix As Long) As Long 窗体是否在屏幕上边或下边，托盘右键【隐藏、显示窗体时需要】 在上顶边,返回-1 在下边,返回1 否则返回0 On Error Resume Next If Me.Top Screen.Height - TaskBarHeight - frmMain.Height - WC_Pix * 15 Then Debug.Print Top + OK FormIsTop = 1 Else FormIsTop = 0 End IfEnd Function【frmMenu】 中 使用菜单编辑器一级：mPop2二级：显示 / 隐藏主界面 名称：mPops2 索引： 0 - 名称：mPops2 索引： 1 【- 用于扩大间隔】 选择默认数据库 名称：mPops2 索引： 2 - 名称：mPops2 索引： 3 【- 用于扩大间隔】 切换当前数据库 名称：mPops2 索引： 4 - 名称：mPops2 索引： 5 【- 用于扩大间隔】 退出 名称：mPops2 索引： 6 代码：Option ExplicitPublic 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 ExplicitPrivate Const WM_MOUSEFIRST = &H200Private Const WM_MOUSEMOVE = &H200Private Const WM_LBUTTONDOWN = &H201Private Const WM_LBUTTONUP = &H202Private Const WM_LBUTTONDBLCLK = &H203Private Const WM_RBUTTONDOWN = &H204Private Const WM_RBUTTONUP = &H205Private Const WM_RBUTTONDBLCLK = &H206Private Const WM_MBUTTONDOWN = &H207Private Const WM_MBUTTONUP = &H208Private Const WM_MBUTTONDBLCLK = &H209Private Const WM_MOUSELAST = &H209Private Const WM_USER = &H400Private Const TRAY_CALLBACK = (WM_USER + 1001&)Private Const NIF_ICON = &H2Private Const NIF_TIP = &H4Private Const NIM_ADD = &H0Private Const NIF_MESSAGE = &H1Private Const NIM_MODIFY = &H1Private Const NIM_DELETE = &H2Private Const PM_REMOVE = &H1Private Const PM_NOREMOVE = &H0Private Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64End TypePrivate Type POINTAPI x As Long y As LongEnd TypePrivate Type Msg hWnd As Long Message As Long wParam As Long lParam As Long time As Long pt As POINTAPIEnd TypePrivate Declare Function Shell_NotifyIcon Lib shell32.dll Alias Shell_NotifyIconA (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongPrivate TheData As NOTIFYICONDATAPublic Event MouseClick(ByVal Button As Long, ByVal DBClick As Boolean)Dim WithEvents cPic As PictureBoxPublic Sub DelTrayIco() 删除托盘图标 DoEvents With TheData .uFlags = 0 End With Shell_NotifyIcon NIM_DELETE, TheDataEnd SubPublic Sub AddTrayIco(ByRef EventPic As PictureBox) 设置托盘图标 On Error Resume Next Set cPic = EventPic With TheData .uID = 0 .hWnd = cPic.hWnd .cbSize = Len(TheData) .uFlags = NIF_ICON .uCallbackMessage = WM_MOUSEMOVE .uFlags = .uFlags Or NIF_MESSAGE End With Shell_NotifyIcon NIM_ADD, TheDataEnd SubPublic Sub SetTrayTip(Tip As String) 设置提示信息 With TheData .szTip = Tip & vbNullChar .uFlags = NIF_TIP End With Shell_NotifyIcon NIM_MODIFY, TheDataEnd SubPublic Sub SetTrayIcon(Pic As StdPicture) If Pic.Type vbPicTypeIcon Then Exit Sub With TheData .hIcon = Pic.Handle .uFlags = NIF_ICON End With Shell_NotifyIcon NIM_MODIFY, TheDataEnd SubPrivate Sub cPic_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) x = x / Screen.TwipsPerPixelX Select Case x Case WM_LBUTTONUP 左键抬起 RaiseEvent MouseClick(vbLeftButton, False) Case WM_LBUTTONDBLCLK 左键双击 RaiseEvent MouseClick(vbLeftButton, True) Case WM_RBUTTONUP 右键抬起 RaiseEvent MouseClick(vbRightButton, False) Case WM_RBUTTONDBLCLK 右键双击 RaiseEvent MouseClick(vbRightButton, True) Case WM_MBUTTONUP 中键抬起 RaiseEvent MouseClick(vbMiddleButton, False) Case WM_MBUTTONDBLCLK 中键双击 RaiseEvent MouseClick(vbMiddleButton, True) End SelectEnd Sub模块：ModGetTaskbar 代码：*模 块 名：ModGetTaskbar*说 明：返回任务栏的信息*Option ExplicitPublic TaskBarHeight As LongPrivate Declare Function SystemParametersInfo Lib user32 Alias SystemParametersInfoA (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As LongPrivate Declare Function FindWindow Lib user32 Alias FindWindowA (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Const SPI_GETWORKAREA = 48Private Type RECT Left As Long Top As Long Right As Long Bottom As L