home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / MyTimezone2220732262012.psc / Classes / clsSystemTray.cls < prev   
Text File  |  2008-10-10  |  15KB  |  483 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsSystemTray"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. 'SystemTray Class
  15. '
  16. 'Author Ben Vonk
  17. '23-09-2010 First version
  18. '27-09-2010 Second version Add Balloon events
  19. '02-10-2010 Third version Add Balloon timer and fixed some bugs
  20. '06-11-2010 Fourth version fixed some bugs
  21. '09-11-2010 Fifth version Add hWnd function and make some changes
  22. '06-12-2010 Sixth version Add ReceivedData event
  23.  
  24. Option Explicit
  25.  
  26. ' Public Events
  27. Public Event BalloonClick()
  28. Public Event BalloonClose()
  29. Public Event BalloonHide()
  30. Public Event BalloonShow()
  31. Public Event BalloonTimeOut()
  32. Public Event Click(Button As Integer)
  33. Public Event DblClick(Button As Integer)
  34. Public Event MouseDown(Button As Integer)
  35. Public Event MouseMove()
  36. Public Event MouseUp(Button As Integer)
  37. Public Event ReceivedData(Data As String)
  38.  
  39. ' Private Constants
  40. Private Const NOTIFYICONDATA_V1_SIZE As Long = 88
  41. Private Const CLASS_NAME             As String = "SystemTray_Class"
  42.  
  43. ' Public Enumeration
  44. Public Enum BalloonIconConstants
  45.    NIIF_NONE = &H0
  46.    NIIF_INFO = &H1
  47.    NIIF_WARNING = &H2
  48.    NIIF_ERROR = &H3
  49.    NIIF_ICON = &H4
  50.    NIIF_GUID = &H5
  51.    NIIF_ASK = &H7
  52.    NIIF_ICON_MASK = &HF
  53. End Enum
  54.  
  55. ' Private Types
  56. Private Type GUID
  57.    Data1                             As Long
  58.    Data2                             As Integer
  59.    Data3                             As Integer
  60.    Data4(7)                          As Byte
  61. End Type
  62.  
  63. Private Type NotifyIconData
  64.    cbSize                            As Long
  65.    hWnd                              As Long
  66.    uID                               As Long
  67.    uFlags                            As Long
  68.    uCallbackMessage                  As Long
  69.    hIcon                             As Long
  70.    szTip                             As String * 128
  71.    dwState                           As Long
  72.    dwStateMask                       As Long
  73.    szInfo                            As String * 256
  74.    uTimeoutAndVersion                As Long
  75.    szInfoTitle                       As String * 64
  76.    dwInfoFlags                       As Long
  77.    guidItem                          As GUID
  78. End Type
  79.  
  80. 'Private Type PointAPI
  81. '   X                                 As Long
  82. '   Y                                 As Long
  83. 'End Type
  84.  
  85. 'Private Type Rect
  86. '   Left                              As Long
  87. '   Top                               As Long
  88. '   Right                             As Long
  89. '   Bottom                            As Long
  90. 'End Type
  91.  
  92. Private Type WindowClass
  93.    style                             As Long
  94.    lpfnwndproc                       As Long
  95.    cbClsextra                        As Long
  96.    cbWndExtra2                       As Long
  97.    hInstance                         As Long
  98.    hIcon                             As Long
  99.    hCursor                           As Long
  100.    hbrBackground                     As Long
  101.    lpszMenuName                      As Long
  102.    lpszClassName                     As String
  103. End Type
  104.  
  105. ' Private Variables
  106. Private m_BalloonClicked             As Boolean
  107. Private m_BalloonClosed              As Boolean
  108. Private m_BalloonShowed              As Boolean
  109. Private m_Enabled                    As Boolean
  110. Private m_Visible                    As Boolean
  111. Private m_hWndHidden                 As Long
  112. Private m_hWndMenu                   As Long
  113. Private m_hWndParent                 As Long
  114. Private m_SizeNID                    As Long
  115. Private m_TimerID                    As Long
  116. Private m_NID                        As NotifyIconData
  117.  
  118. ' Private API's
  119. Private Declare Function ShellNotifyIcon Lib "Shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NotifyIconData) As Long
  120. Private Declare Function CreateWindowEx Lib "User32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  121. 'Private Declare Function GetCursorPos Lib "User32" (lpPoint As PointAPI) As Long
  122. 'Private Declare Function GetSystemMenu Lib "User32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
  123. 'Private Declare Function KillTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
  124. 'Private Declare Function PostMessage Lib "User32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  125. Private Declare Function RegisterClass Lib "User32" Alias "RegisterClassA" (Class As WindowClass) As Long
  126. 'Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  127. 'Private Declare Function SetForegroundWindow Lib "User32" (ByVal hWnd As Long) As Long
  128. 'Private Declare Function SetTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  129. 'Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  130. 'Private Declare Function TrackPopupMenu Lib "User32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hWnd As Long, lprc As Rect) As Long
  131. Private Declare Function UnregisterClass Lib "User32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
  132. Private Declare Function GetFileVersionInfoSize Lib "Version" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
  133. Private Declare Function GetFileVersionInfo Lib "Version" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
  134. Private Declare Function VerQueryValue Lib "Version" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lpBuffer As Any, nVerSize As Long) As Long
  135.  
  136. Public Property Get Enabled() As Boolean
  137.  
  138.    Enabled = m_Enabled
  139.  
  140. End Property
  141.  
  142. Public Property Let Enabled(ByVal NewEnabled As Boolean)
  143.  
  144.    m_Enabled = NewEnabled
  145.  
  146. End Property
  147.  
  148. Public Property Get Icon() As Long
  149.  
  150.    Icon = m_NID.hIcon
  151.  
  152. End Property
  153.  
  154. Public Property Let Icon(ByVal NewIcon As Long)
  155.  
  156.    m_NID.hIcon = NewIcon
  157.    
  158.    Call ModifyIcon(m_BalloonShowed)
  159.  
  160. End Property
  161.  
  162. Public Property Get Menu() As Long
  163.  
  164.    Menu = m_hWndMenu
  165.  
  166. End Property
  167.  
  168. Public Property Let Menu(ByVal NewMenu As Long)
  169.  
  170.    m_hWndMenu = NewMenu
  171.  
  172. End Property
  173.  
  174. Public Property Get Parent() As Long
  175.  
  176.    Parent = m_hWndParent
  177.  
  178. End Property
  179.  
  180. Public Property Let Parent(ByRef NewParent As Long)
  181.  
  182.    m_hWndParent = NewParent
  183.  
  184. End Property
  185.  
  186. Public Property Get TipText() As String
  187.  
  188.    TipText = m_NID.szTip
  189.  
  190. End Property
  191.  
  192. Public Property Let TipText(ByVal NewTipText As String)
  193.  
  194.    m_NID.szTip = NewTipText & vbNullChar
  195.    
  196.    Call ModifyIcon(m_BalloonShowed)
  197.  
  198. End Property
  199.  
  200. Public Function hWnd() As Long
  201.  
  202.    hWnd = m_hWndHidden
  203.  
  204. End Function
  205.  
  206. Public Function Visible() As Boolean
  207.  
  208.    Visible = m_Visible
  209.  
  210. End Function
  211.  
  212. Public Sub AddIcon()
  213.  
  214. Const NIM_ADD As Long = &H0
  215.  
  216.    Debug.Assert m_Visible = False
  217.    ShellNotifyIcon NIM_ADD, m_NID
  218.    m_Visible = True
  219.  
  220. End Sub
  221.  
  222. Public Sub DeleteIcon()
  223.  
  224. Const NIM_DELETE As Long = &H2
  225.  
  226.    If m_TimerID Then m_TimerID = KillTimer(m_hWndParent, ObjPtr(Me) + 1)
  227.    
  228.    Debug.Assert m_Visible
  229.    ShellNotifyIcon NIM_DELETE, m_NID
  230.    m_Visible = False
  231.  
  232. End Sub
  233.  
  234. Public Sub HideBalloon()
  235.  
  236.    If m_TimerID > 0 Then If KillTimer(m_hWndHidden, ObjPtr(Me) + 1) = 1 Then m_TimerID = 0
  237.    If Not m_BalloonShowed Then Exit Sub
  238.    
  239.    With m_NID
  240.       .dwInfoFlags = 0
  241.       .szInfoTitle = vbNullChar
  242.       .szInfo = vbNullChar
  243.       m_BalloonShowed = False
  244.    End With
  245.    
  246.    Call ModifyIcon
  247.  
  248. End Sub
  249.  
  250. Public Sub RecreateIcon()
  251.  
  252.    If m_Visible Then
  253.       m_Visible = False
  254.       
  255.       Call AddIcon
  256.    End If
  257.  
  258. End Sub
  259.  
  260. Public Sub ShowBalloon(ByVal Title As String, ByVal Info As String, Optional ByVal BalloonIcon As BalloonIconConstants = NIIF_INFO, Optional ByVal TimeOut As Long, Optional ByVal Sound As Boolean)
  261.  
  262. Const NIF_INFO     As Long = &H10
  263. Const NIIF_NOSOUND As Long = &H10
  264.  
  265.    If Not m_Enabled Or (m_SizeNID = NOTIFYICONDATA_V1_SIZE) Then Exit Sub
  266.    
  267.    With m_NID
  268.       .uFlags = .uFlags Or NIF_INFO
  269.       .cbSize = m_SizeNID
  270.       .dwInfoFlags = BalloonIcon Or (NIIF_NOSOUND And Not Sound)
  271.       .szInfoTitle = Title & vbNullChar
  272.       .szInfo = Info & vbNullChar
  273.       m_BalloonClicked = False
  274.       m_BalloonClosed = False
  275.       m_BalloonShowed = True
  276.    End With
  277.    
  278.    Call ModifyIcon
  279.    
  280.    If (TimeOut > 0) And (m_TimerID = 0) Then m_TimerID = SetTimer(m_hWndHidden, ObjPtr(Me) + 1, TimeOut, AddressOf SystemTrayWndProc)
  281.  
  282. End Sub
  283.  
  284. Friend Sub ProcessMessage(ByVal ID As Long, ByVal MouseEvent As Long, Optional ByVal SendData As String)
  285.  
  286. Const NIN_BALLOONHIDE      As Long = &H403
  287. Const NIN_BALLOONSHOW      As Long = &H402
  288. Const NIN_BALLOONTIMEOUT   As Long = &H404
  289. Const NIN_BALLOONUSERCLICK As Long = &H405
  290. 'Const WM_LBUTTONDBLCLK     As Long = &H203
  291. 'Const WM_LBUTTONDOWN       As Long = &H201
  292. 'Const WM_LBUTTONUP         As Long = &H202
  293. Const WM_MBUTTONDBLCLK     As Long = &H209
  294. Const WM_MBUTTONDOWN       As Long = &H207
  295. Const WM_MBUTTONUP         As Long = &H208
  296. 'Const WM_MOUSEMOVE         As Long = &H200
  297. Const WM_RBUTTONDBLCLK     As Long = &H206
  298. 'Const WM_RBUTTONDOWN       As Long = &H204
  299. Const WM_RBUTTONUP         As Long = &H205
  300.  
  301.    If m_Enabled Then
  302.       If (m_TimerID > 0) And (m_TimerID = ID) Then
  303.          If Not m_BalloonClicked And Not m_BalloonClosed Then
  304.             Call HideBalloon
  305.             
  306.             RaiseEvent BalloonTimeOut
  307.          End If
  308.          
  309.       Else
  310.          Select Case MouseEvent
  311.             Case NIN_BALLOONHIDE
  312.                RaiseEvent BalloonHide
  313.                
  314.             Case NIN_BALLOONSHOW
  315.                RaiseEvent BalloonShow
  316.                
  317.             Case NIN_BALLOONTIMEOUT
  318.                Call HideBalloon
  319.                
  320.                m_BalloonClosed = True
  321.                RaiseEvent BalloonClose
  322.                
  323.             Case NIN_BALLOONUSERCLICK
  324.                Call HideBalloon
  325.                
  326.                m_BalloonClicked = True
  327.                RaiseEvent BalloonClick
  328.                
  329.             Case WM_ACTIVATE
  330.                If ID = 0 Then RaiseEvent ReceivedData(SendData)
  331.                
  332.             Case WM_LBUTTONDBLCLK
  333.                RaiseEvent DblClick(vbLeftButton)
  334.                
  335.             Case WM_LBUTTONDOWN
  336.                RaiseEvent MouseDown(vbLeftButton)
  337.                
  338.             Case WM_LBUTTONUP
  339.                RaiseEvent MouseUp(vbLeftButton)
  340.                RaiseEvent Click(vbLeftButton)
  341.                
  342.             Case WM_MBUTTONDBLCLK
  343.                RaiseEvent DblClick(vbMiddleButton)
  344.                
  345.             Case WM_MBUTTONDOWN
  346.                RaiseEvent MouseDown(vbMiddleButton)
  347.                
  348.             Case WM_MBUTTONUP
  349.                RaiseEvent MouseUp(vbMiddleButton)
  350.                RaiseEvent Click(vbMiddleButton)
  351.                
  352.             Case WM_MOUSEMOVE
  353.                RaiseEvent MouseMove
  354.                
  355.             Case WM_RBUTTONDBLCLK
  356.                RaiseEvent DblClick(vbRightButton)
  357.                
  358.             Case WM_RBUTTONDOWN
  359.                RaiseEvent MouseDown(vbRightButton)
  360.                
  361.             Case WM_RBUTTONUP
  362.                If m_hWndMenu Then
  363.                   Call ShowMenu
  364.                   
  365.                Else
  366.                   RaiseEvent MouseUp(vbRightButton)
  367.                   RaiseEvent Click(vbRightButton)
  368.                End If
  369.          End Select
  370.       End If
  371.       
  372.    Else
  373.       SetForegroundWindow m_hWndParent
  374.    End If
  375.  
  376. End Sub
  377.  
  378. Private Sub ModifyIcon(Optional ByVal Cancel As Boolean)
  379.  
  380. Const NIM_MODIFY As Long = &H1
  381.  
  382.    If Not m_Enabled Or Not m_Visible Or Cancel Then Exit Sub
  383.    
  384.    Debug.Assert m_Visible
  385.    ShellNotifyIcon NIM_MODIFY, m_NID
  386.  
  387. End Sub
  388.  
  389. Private Sub ShowMenu()
  390.  
  391. 'Const TPM_RETURNCMD   As Long = &H100
  392. 'Const TPM_RIGHTBUTTON As Long = &H2
  393. 'Const TPM_TOPALIGN    As Long = &H0
  394. 'Const WM_SYSCOMMAND   As Long = &H112&
  395.  
  396. Dim lngMenu           As Long
  397. Dim lngMenuID         As Long
  398. Dim ptaCursorPos      As PointAPI
  399. Dim rctMenu           As Rect
  400.  
  401.    lngMenu = GetSystemMenu(m_hWndMenu, &H0&)
  402.    
  403.    If lngMenu = 0 Then Exit Sub
  404.    
  405.    GetCursorPos ptaCursorPos
  406.    SetForegroundWindow m_hWndParent
  407.    lngMenuID = TrackPopupMenu(lngMenu, TPM_RETURNCMD Or TPM_RIGHTBUTTON Or TPM_TOPALIGN, ptaCursorPos.X, ptaCursorPos.Y, 0, m_hWndMenu, rctMenu)
  408.    
  409.    If lngMenuID Then PostMessage m_hWndMenu, WM_SYSCOMMAND, lngMenuID, lngMenu
  410.  
  411. End Sub
  412.  
  413. Private Sub Class_Initialize()
  414.  
  415. Const NIF_ICON               As Long = &H2
  416. Const NIF_MESSAGE            As Long = &H1
  417. Const NIF_TIP                As Long = &H4
  418. Const NOTIFYICONDATA_V2_SIZE As Long = 488
  419. Const NOTIFYICONDATA_V3_SIZE As Long = 504
  420. Const SHELL_32               As String = "Shell32"
  421.  
  422. Dim lngReturn                As Long
  423. Dim lngVersion               As Long
  424. Dim wndClass                 As WindowClass
  425.  
  426.    lngReturn = GetFileVersionInfoSize(SHELL_32, 0)
  427.    
  428.    If lngReturn > 0 Then
  429.       ReDim bytBuffer(lngReturn - 1) As Byte
  430.       
  431.       GetFileVersionInfo SHELL_32, 0, lngReturn, bytBuffer(0)
  432.       
  433.       If VerQueryValue(bytBuffer(0), "\", lngReturn, 0) = 1 Then lngVersion = GetVersion(lngReturn + 10)
  434.       
  435.       Erase bytBuffer
  436.    End If
  437.    
  438.    If lngVersion < 5 Then
  439.       m_SizeNID = NOTIFYICONDATA_V1_SIZE
  440.       
  441.    ElseIf lngVersion = 6 Then
  442.       m_SizeNID = NOTIFYICONDATA_V2_SIZE
  443.       
  444.    Else
  445.       m_SizeNID = NOTIFYICONDATA_V3_SIZE
  446.    End If
  447.    
  448.    With wndClass
  449.       .lpfnwndproc = Pass(AddressOf SystemTrayWndProc)
  450.       .hInstance = App.hInstance
  451.       .lpszClassName = CLASS_NAME
  452.    End With
  453.    
  454.    m_Enabled = True
  455.    RegisterClass wndClass
  456.    m_hWndHidden = CreateWindowEx(0, CLASS_NAME, CLASS_NAME_HIDDEN & App.Title, 0, 0, 0, 100, 100, 0, 0, 0, ByVal 0)
  457.    SetWindowLong m_hWndHidden, GWL_USERDATA, CreateRef(Me)
  458.    
  459.    Call InitMessage
  460.    
  461.    With m_NID
  462.       .cbSize = m_SizeNID
  463.       .hWnd = m_hWndHidden
  464.       .szTip = vbNullString
  465.       .uCallbackMessage = WM_USER_SYSTRAY
  466.       .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
  467.    End With
  468.  
  469. End Sub
  470.  
  471. Private Sub Class_Terminate()
  472.  
  473. Const WM_CLOSE As Long = &H10
  474.  
  475.    SendMessage m_hWndHidden, WM_CLOSE, 0, ByVal 0&
  476.    
  477.    If m_Visible Then DeleteIcon
  478.    
  479.    UnregisterClass CLASS_NAME, App.hInstance
  480.  
  481. End Sub
  482.  
  483.