systray.bas

vb 写的播放器 对新的开发者很有用。写的不错。非常实际

Attribute VB_Name = "Systray"

' **********************************************************************
'  描  述：存vb代码写的winnap程序，非常酷
'  Play78.com : 网站导航，源码之家，绝对开源
'  海阔天空收集整理
'  主站地址：http://www.play78.com/
'  源码下载地址：http://www.play78.com/blog
'  图片下在地址：http://www.play78.com/pic
'  QQ：13355575
'  e-mail:[e-mail]
'  编写日期：2005年08月30日
' **********************************************************************

Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'dwMessage成员，分别为：添加、删除、更改图标
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1

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         '为图标显示的工具提示(Tooltip)文本
End Type
'uFlags成员
Public Const NIF_ICON = &H2          '成员hIcon是合法的
Public Const NIF_MESSAGE = &H1       '成员uCallbackMessage是合法的
Public Const NIF_TIP = &H4           '成员szTip是合法的

Public 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
'将消息传给指定的窗口程序

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'改变指定窗口的属性，并把一个32位值放在窗口附加存储空间的指定偏移位置。
'nIndex：指定要设置的大于等于0的偏移值。
Public Const GWL_EXSTYLE = (-20) '设置一种新的窗口扩展风格
Public Const GWL_HINSTANCE = (-6) '设置一个新的应用程序事例句柄
Public Const GWL_HWNDPARENT = (-8) '
Public Const GWL_ID = (-12) '设置一个新的窗口标识符
Public Const GWL_STYLE = (-16) '设置一种新的窗口风格
Public Const GWL_USERDATA = (-21) '设置与窗口有关的32位值
'Public Const GWL_WNDPROC = (-4) '为窗口过程设定一个新的地址
'如果hWnd标识的是对话框，则nIndex为下列值：
Public Const DWL_DLGPROC = 4 '设置对话框过程的新地址
Public Const DWL_MSGRESULT = 0 '设置在对话框过程中处理的消息的返回值
Public Const DWL_USER = 8 '应用程序私有的新的额外信息，如句柄指针

Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_USER = &H400

Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public NOTI As NOTIFYICONDATA
Public preWinProc As Long
Public NewForm As Form
Public NewMenu As Menu

Public Function NewWindone(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
  Mainfrm.Show
  If Mainfrm.EQFlag = True Then
   EQfrm.Show
  End If
  If Mainfrm.PLFlag = True Then
   Listfrm.Show
  End If
  Mainfrm.ReFlashForm.Enabled = True
 End If
 If lParam = WM_RBUTTONUP Then
  NewForm.PopupMenu NewMenu
 End If
End If
NewWindone = CallWindowProc(preWinProc, hwnd, msg, wParam, lParam)
End Function

Public Sub AddTray(Frm As Form, mnu As Menu)
Set NewForm = Frm
Set NewMenu = mnu
'用NewWindone取代原窗口程序
preWinProc = SetWindowLong(Frm.hwnd, GWL_WNDPROC, AddressOf NewWindone)

With NOTI
 .uID = 0
 .hwnd = Frm.hwnd
 .cbSize = Len(NOTI)
 .hIcon = Frm.Icon.Handle
 .uFlags = NIF_ICON
 .uCallbackMessage = TRAY_CALLBACK
 .uFlags = .uFlags Or NIF_MESSAGE
 .cbSize = Len(NOTI)
End With
Shell_NotifyIcon NIM_ADD, NOTI
End Sub

Public Sub RemoveTray()
NOTI.uFlags = 0
Shell_NotifyIcon NIM_DELETE, NOTI
End Sub

Public Sub SetTrayTip(Tip As String)
With NOTI
 .szTip = Tip & vbNullChar
 .uFlags = NIF_TIP
End With
Shell_NotifyIcon NIM_MODIFY, NOTI
End Sub