home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD90448172000.psc / clsSysTray.cls next >
Encoding:
Visual Basic class definition  |  2000-07-17  |  13.5 KB  |  371 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 = "clsSysTray"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. '*:********************************************************************************
  15. '*: Class. . . . . . . . . . : clsSysTray.cls
  16. '*: Description. . . . . . . : When the application is minimized, it minimizes to
  17. '*:                            be an icon in the system tray.
  18. '*: Author . . . . . . . . . : Martin Richardson
  19. '*: Acknowledgements . . . . : Mark Hunter (system tray routines)
  20. '*: Copyright. . . . . . . . : This class is freeware
  21. '*:
  22. '*: VB Versions:
  23. '*:
  24. '*: NOTE:  ICONS can have no more then max of 16 colors
  25. '*:
  26. '*: 5.0 - Change the following constant definition to:
  27. '*:        Private Const VB_VERSION = 5
  28.  
  29. #Const VB_VERSION = 6
  30.  
  31. '*:     - Add a picturebox control to your form, turn visible for it off, and
  32. '*:       call it "pichook"
  33. '*:
  34. '*: 6.0 - Make sure the VB_VERSION constant is set to value of 6
  35. '*:********************************************************************************
  36. '*: Code to set up in the main form:
  37.  
  38. 'Private WithEvents gSysTray As clsSysTray
  39.  
  40. 'Private Sub Form_Load()
  41. '    Set gSysTray = New clsSysTray
  42. '    Set gSysTray.SourceWindow = Me
  43. 'End Sub
  44.  
  45. 'Private Sub Form_Resize()
  46. '    If Me.WindowState = vbMinimized Then
  47. '        gSysTray.MinToSysTray
  48. '    End If
  49. 'End Sub
  50.  
  51. '*: For VB5.0, add an invisible picture box to the form and call it "pichook"
  52.  
  53. '*: Properties
  54. '*:
  55. '*: Icon
  56. '*:     Icon displayed in the taskbar.  Use this property to set the icon, or return
  57. '*:     it.
  58. '*: ToolTip
  59. '*:     Tooltip text displayed when the mouse is over the icon in the system tray.  Use
  60. '*:     this property to assign text to the tooltip, or to return the value of it.
  61. '*: SourceWindow As Form
  62. '*:     Reference to the form which will minimize to the system tray.
  63. '*: DefaultDblClk As Boolean
  64. '*:     Set to True to fire the DEFAULT (defined below) for the mouse double click event
  65. '*:     which will show the application and remove the icon from the tray. (default)
  66. '*:     Set to FALSE to override the below default event.
  67. '*:
  68. '*: Methods:
  69. '*:
  70. '*: MinToSysTray
  71. '*:     Minimize the application, have it appear as an icon in the system tray.
  72. '*:     The applicion disappears from the task bar and only appears in the
  73. '*:     system tray.
  74. '*: IconInSysTray
  75. '*:     Create an icon for the application in the system tray, but leave the icon
  76. '*:     visible and on the task bar.
  77. '*: RemoveFromSysTray
  78. '*:     Remove the icon from the system tray.
  79. '*:
  80. '*: These methods are available, but the same actions can be accomplished by
  81. '*: setting the ICON and TOOLTIP properties.
  82. '*:
  83. '*: ChangeToolTip( sNewToolTip As String )
  84. '*:     Set/change the tooltip displayed when the mouse is over the tray icon.
  85. '*:     ex: gSysTray.ChangeToolTip "Processing..."
  86. '*: ChangeIcon( pNewIcon As Picture )
  87. '*:     Set/change the icon which appears in the system tray.  The default icon
  88. '*:     is the icon of the form.
  89. '*:     ex: gSysTray.ChangeIcon ImageList1.ListImages("busyicon").picture
  90. '*:
  91. '*: Events:
  92. '*:
  93. '*: LButtonDblClk
  94. '*:     Fires when double clicking the left mouse button over the tray icon.  This event
  95. '*:     has default code which will show the form and remove the icon from the
  96. '*:     system tray when it fires.  Set the property DefaultDblClk to False to
  97. '*:     bypass this code.
  98. '*: LButtonDown
  99. '*:     Fires when the left mouse button goes down over the tray icon.
  100. '*: LButtonUp
  101. '*:     Fires when the left mouse button comes up over the tray icon.
  102. '*: RButtonDblClk
  103. '*:     Fires when double clicking the right mouse button over the tray icon.
  104. '*: RButtonDown
  105. '*:     Fires when the right mouse button goes down over the tray icon.
  106. '*: RButtonUp
  107. '*:     Fires when the right mouse button comes up over the tray icon.
  108. '*:     Best place for calling a popup menu.
  109. '*:
  110. '*: Example of utilizing a popup menu with the RButtonUp event:
  111. '*: 1.  Create a menu on the form being minimized, or on it's own seperate form.
  112. '*:     Let's say the form with the menu is called frmMenuForm.
  113. '*: 2.  Set the name of the root menu item to be mnuRightClickMenu
  114. '*: 3.  Assuming the name of the global SysTray object is still gSysTray, use this code
  115. '*:     in the main form:
  116. '*:
  117. 'Private Sub gSysTray_RButtonUP()
  118. '    PopUpMenu frmMenuForm.mnuRightClickMenu
  119. 'End Sub
  120. '*:
  121. '*:********************************************************************************
  122.  
  123. '*:********************************************************************************
  124. '*: User Defined Types
  125. '*:********************************************************************************
  126. Private Type NOTIFYICONDATA
  127.     cbSize As Long
  128.     hwnd As Long
  129.     uId As Long
  130.     uFlags As Long
  131.     ucallbackMessage As Long
  132.     hIcon As Long
  133.     szTip As String * 64
  134. End Type
  135.  
  136. '*:********************************************************************************
  137. '*: Constants
  138. '*:********************************************************************************
  139. Private Const NIM_ADD = &H0
  140. Private Const NIM_MODIFY = &H1
  141. Private Const NIM_DELETE = &H2
  142. Private Const WM_MOUSEMOVE = &H200
  143. Private Const NIF_MESSAGE = &H1
  144. Private Const NIF_ICON = &H2
  145. Private Const NIF_TIP = &H4
  146.  
  147. Private Const WM_LBUTTONDBLCLK = &H203
  148. Private Const WM_LBUTTONDOWN = &H201
  149. Private Const WM_LBUTTONUP = &H202
  150. Private Const WM_RBUTTONDBLCLK = &H206
  151. Private Const WM_RBUTTONDOWN = &H204
  152. Private Const WM_RBUTTONUP = &H205
  153.  
  154. '*:********************************************************************************
  155. '*: API Declarations
  156. '*:********************************************************************************
  157. Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
  158.  
  159. '*:********************************************************************************
  160. '*: Local variables
  161. '*:********************************************************************************
  162. Private t As NOTIFYICONDATA
  163. Private WithEvents pichook As PictureBox
  164. Attribute pichook.VB_VarHelpID = -1
  165. Private mvarToolTip As String
  166.  
  167. '*:********************************************************************************
  168. '*: Events
  169. '*:********************************************************************************
  170. Public Event LButtonDblClk()
  171. Public Event LButtonDown()
  172. Public Event LButtonUp()
  173. Public Event RButtonDblClk()
  174. Public Event RButtonDown()
  175. Public Event RButtonUp()
  176.  
  177. '*:********************************************************************************
  178. '*: local variable(s) to hold property value(s)
  179. '*:********************************************************************************
  180. Private mvarSourceWindow As Form 'local copy
  181. Private mvarDefaultDblClk As Boolean 'local copy
  182.  
  183. '*:********************************************************************************
  184. '*: Tooltip Property
  185. '*:********************************************************************************
  186. Public Property Let ToolTip(ByVal vData As String)
  187.     ChangeToolTip vData
  188. End Property
  189.  
  190. Public Property Get ToolTip() As String
  191.     ToolTip = mvarToolTip
  192. End Property
  193.  
  194. '*:********************************************************************************
  195. '*: Icon Property
  196. '*:********************************************************************************
  197. Public Property Let Icon(ByVal vData As Variant)
  198.     ChangeIcon vData
  199. End Property
  200.  
  201. Public Property Get Icon() As Variant
  202.     Icon = t.hIcon      'pichook.Picture
  203. End Property
  204.  
  205. '*:********************************************************************************
  206. '*: DefaultDblClk Property
  207. '*:********************************************************************************
  208. Public Property Let DefaultDblClk(ByVal vData As Boolean)
  209.     mvarDefaultDblClk = vData
  210. End Property
  211.  
  212. Public Property Get DefaultDblClk() As Boolean
  213.     DefaultDblClk = mvarDefaultDblClk
  214. End Property
  215.  
  216. '*:********************************************************************************
  217. '*: SourceWindow Property
  218. '*:********************************************************************************
  219. Public Property Set SourceWindow(ByVal vData As Form)
  220.     Set mvarSourceWindow = vData
  221.     SetPicHook
  222. End Property
  223.  
  224. Public Property Get SourceWindow() As Form
  225.     Set SourceWindow = mvarSourceWindow
  226. End Property
  227.  
  228. '*:********************************************************************************
  229. '*: Class Initialize
  230. '*:********************************************************************************
  231. Private Sub Class_Initialize()
  232.     mvarDefaultDblClk = True
  233.     
  234.     t.cbSize = Len(t)
  235.     t.uId = 1&
  236.     t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
  237.     t.ucallbackMessage = WM_MOUSEMOVE
  238.     t.hIcon = Me.Icon
  239.     t.szTip = Chr$(0)       'Default to no tooltip
  240. End Sub
  241.  
  242. '*:********************************************************************************
  243. '*: Mousemove event of the pichook control
  244. '*:********************************************************************************
  245. Private Sub pichook_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  246.     Static rec As Boolean, msg As Long, oldmsg As Long
  247.     
  248.     oldmsg = msg
  249.     msg = X / Screen.TwipsPerPixelX
  250.    
  251.     If rec = False Then
  252.         rec = True
  253.         Select Case msg
  254.             Case WM_LBUTTONDBLCLK:
  255.                 LButtonDblClk
  256.             Case WM_LBUTTONDOWN:
  257.                 LButtonDown
  258.             Case WM_LBUTTONUP:
  259.                 RaiseEvent LButtonUp
  260.             Case WM_RBUTTONDBLCLK:
  261.                 RaiseEvent RButtonDblClk
  262.             Case WM_RBUTTONDOWN:
  263.                 RaiseEvent RButtonDown
  264.             Case WM_RBUTTONUP:
  265.                 RaiseEvent RButtonUp
  266.         End Select
  267.         rec = False
  268.     End If
  269. End Sub
  270.  
  271. '*:********************************************************************************
  272. '*: Default LButtonDblClk event
  273. '*:
  274. '*: Since VB doesn't really have inheretance (&^$%#&*!!) we have to fake it by
  275. '*: using a variable to override default events...
  276. '*:********************************************************************************
  277. Private Sub LButtonDblClk()
  278.     If mvarDefaultDblClk Then
  279.         mvarSourceWindow.WindowState = vbNormal
  280.         mvarSourceWindow.Show
  281.         App.TaskVisible = True
  282.         RemoveFromSysTray
  283.     End If
  284.     
  285.     RaiseEvent LButtonDblClk
  286. End Sub
  287.  
  288. '*:********************************************************************************
  289. '*: RemoveFromSysTray - Call to remove the icon from the system tray
  290. '*:********************************************************************************
  291. Public Sub RemoveFromSysTray()
  292.     t.cbSize = Len(t)
  293.     t.hwnd = pichook.hwnd
  294.     t.uId = 1&
  295.     Shell_NotifyIcon NIM_DELETE, t
  296. End Sub
  297.  
  298. '*:********************************************************************************
  299. '*: IconInSysTray - Call to place an icon in the system tray
  300. '*:********************************************************************************
  301. Public Sub IconInSysTray()
  302.     Shell_NotifyIcon NIM_ADD, t
  303. End Sub
  304.  
  305. '*:********************************************************************************
  306. '*: MinToSysTray - Call to minimize the application, remove it from the Task
  307. '*: manager, and place an icon in the system tray
  308. '*:********************************************************************************
  309. Public Sub MinToSysTray()
  310.     Me.IconInSysTray
  311.     
  312.     mvarSourceWindow.Hide
  313.     App.TaskVisible = False
  314. End Sub
  315. '*:********************************************************************************
  316. '*: SetPicHook - Sets up the pichook control
  317. '*:********************************************************************************
  318. Private Sub SetPicHook()
  319. On Error GoTo AlreadyAdded
  320. #If VB_VERSION = 6 Then
  321.     Set pichook = mvarSourceWindow.Controls.Add("VB.PictureBox", "pichook")
  322. #Else
  323.     Set pichook = mvarSourceWindow.pichook
  324. #End If
  325.  
  326.     pichook.Visible = False
  327.     pichook.Picture = mvarSourceWindow.Icon
  328.     t.hwnd = pichook.hwnd
  329.     
  330.     Exit Sub
  331.  
  332. AlreadyAdded:
  333.     If Err.Number <> 727 Then  ' pichook has already been added
  334.        MsgBox "Run-time error '" & Err.Number & "':" & vbCrLf & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Error"
  335.        Stop
  336.        Resume
  337.     End If
  338. End Sub
  339.  
  340. '*:********************************************************************************
  341. '*: ChangeIcon - Change the system tray icon
  342. '*:********************************************************************************
  343. Public Sub ChangeIcon(toNewIcon)
  344.     Set pichook.Picture = toNewIcon
  345.     t.hIcon = pichook.Picture
  346.     Shell_NotifyIcon NIM_MODIFY, t
  347. End Sub
  348.  
  349. '*:********************************************************************************
  350. '*: ChangeToolTip - Change the systray icon tooltip
  351. '*:********************************************************************************
  352. Public Sub ChangeToolTip(ByVal cNewTip As String)
  353.     mvarToolTip = cNewTip
  354.     t.szTip = cNewTip & Chr$(0)
  355.     Shell_NotifyIcon NIM_MODIFY, t
  356.     If mvarSourceWindow.WindowState = vbMinimized Then
  357.         mvarSourceWindow.Caption = cNewTip
  358.     End If
  359. End Sub
  360.  
  361. Public Sub LButtonDown()
  362.     If mvarDefaultDblClk Then
  363.         mvarSourceWindow.WindowState = vbNormal
  364.         mvarSourceWindow.Show
  365.         App.TaskVisible = True
  366.         RemoveFromSysTray
  367.     End If
  368.     
  369.     RaiseEvent LButtonDown
  370. End Sub
  371.