home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Instant_Pr1856912232005.psc / clsTray.cls < prev    next >
Text File  |  2005-02-23  |  4KB  |  164 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 = "clsTray"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16.  
  17. '[EVENTS]
  18. Event RButton()
  19. Event LButton()
  20. Event AddedToTray()
  21. Event RemovedFromTray()
  22.  
  23. '[TYPES]
  24. Private Type NOTIFYICONDATA
  25.     cbSize As Long
  26.     hwnd As Long
  27.     uId As Long
  28.     uFlags As Long
  29.     uCallBackMessage As Long
  30.     hIcon As Long
  31.     szTip As String * 64
  32. End Type
  33.  
  34. '[CONTANTS]
  35. Private Const NIM_ADD = &H0  'Add to Tray
  36. Private Const NIM_MODIFY = &H1 'Modify Details
  37. Private Const NIM_DELETE = &H2 'Remove From Tray
  38. Private Const NIF_MESSAGE = &H1 'Message
  39. Private Const NIF_ICON = &H2 'Icon
  40. Private Const NIF_TIP = &H4 'TooTipText
  41. Private Const WM_MOUSEMOVE = &H200 'On Mousemove
  42. Private Const WM_LBUTTONDBLCLK = &H203 'Left Double Click
  43. Private Const WM_RBUTTONDOWN = &H204 'Right Button Down
  44. Private Const WM_RBUTTONUP = &H205 'Right Button Up
  45. Private Const WM_RBUTTONDBLCLK = &H206 'Right Double Click
  46.  
  47. '[API]
  48. Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
  49.  
  50. '[OBJECT VARIABLES]
  51. Private WithEvents picTray As PictureBox
  52. Attribute picTray.VB_VarHelpID = -1
  53.  
  54. '[PRIVATE VARIABLES]
  55. Private TrayIco As NOTIFYICONDATA
  56. Private InTray As Boolean
  57.  
  58.  
  59.  
  60. Sub AddToTray(picBoxIcon As PictureBox, sTrayTip As String)
  61. On Error GoTo ERR_HANDLER:
  62. '-------------------------------------------------
  63. ' ltray icon will be the forms icon unless
  64. ' specified otherwise
  65. '-------------------------------------------------
  66. 'VARIABLES:
  67.  
  68. 'CODE:
  69.    Set picTray = picBoxIcon
  70.    InTray = True
  71.  
  72.    'initialize tray info
  73.    With TrayIco
  74.             .cbSize = Len(TrayIco)
  75.             .hwnd = picBoxIcon.hwnd
  76.             .uId = vbNull
  77.             .uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
  78.             .uCallBackMessage = WM_MOUSEMOVE
  79.             .hIcon = picTray.Picture
  80.             .szTip = sTrayTip & vbNullChar 'the tray tooltip
  81.    End With
  82.    'add this to tray
  83.    Shell_NotifyIcon NIM_ADD, TrayIco
  84.  
  85. 'END CODE:
  86. Exit Sub
  87. ERR_HANDLER:
  88.   Debug.Print Err.Description
  89. End Sub
  90.  
  91. Sub RemoveFromTray()
  92. On Error GoTo ERR_HANDLER:
  93. '-------------------------------------------------
  94. ' remove the icon from tray..either because showing
  95. ' form or ending app
  96. '-------------------------------------------------
  97. 'VARIABLES:
  98.  
  99. 'CODE:
  100.   'remove the tray icon
  101.    Shell_NotifyIcon NIM_DELETE, TrayIco
  102.    InTray = False
  103. 'END CODE:
  104. Exit Sub
  105. ERR_HANDLER:
  106.   Debug.Print Err.Description
  107. End Sub
  108.  
  109. Sub ModifyTray(Optional sNewToolTip As String, Optional lNewIcon As Long)
  110. On Error GoTo ERR_HANDLER:
  111. '-------------------------------------------------
  112. ' change either the tooltip of the icon associated
  113. ' with tray icon
  114. '-------------------------------------------------
  115. 'VARIABLES:
  116.  
  117. 'CODE:
  118.  With TrayIco
  119.    If lNewIcon <> 0 Then .hIcon = lNewIcon
  120.    If Len(Trim(sNewToolTip)) > 0 Then .szTip = sNewToolTip & vbNullChar
  121.  End With
  122.  'update tray icon with new values
  123.  Shell_NotifyIcon NIM_MODIFY, TrayIco
  124. 'END CODE:
  125. Exit Sub
  126. ERR_HANDLER:
  127.   Debug.Print Err.Description
  128. End Sub
  129.  
  130. Private Sub PicTray_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  131. On Error GoTo ERR_HANDLER:
  132. '-------------------------------------------------
  133. 'this sub is called when the mouse moves over the tray
  134. 'icon because trays callback msg is wm_mousemove
  135. '-=[thanks to LCSBSSRHXXX for the much shortened tray code]=-
  136. '-------------------------------------------------
  137. 'VARIABLES:
  138.  
  139. 'CODE:
  140.     Select Case InTray
  141.         Case True
  142.             If Button = 1 Then 'left click
  143.                 RaiseEvent LButton
  144.             ElseIf Button = 2 Then 'right click
  145.                 RaiseEvent RButton
  146.             End If
  147.         Case False
  148.             Exit Sub
  149.     End Select
  150. 'END CODE:
  151. Exit Sub
  152. ERR_HANDLER:
  153.   Debug.Print Err.Description
  154. End Sub
  155.  
  156.  
  157. Private Sub Class_Terminate()
  158. '-----------------------------
  159. 'destroy local object reference
  160. '-----------------------------
  161.  On Error Resume Next
  162.  Set picTray = Nothing
  163. End Sub
  164.