home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / howtos1r / systray.ctl < prev    next >
Encoding:
Text File  |  1997-01-16  |  15.1 KB  |  313 lines
  1. VERSION 5.00
  2. Begin VB.UserControl cSysTray 
  3.    CanGetFocus     =   0   'False
  4.    ClientHeight    =   510
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   510
  8.    ClipControls    =   0   'False
  9.    EditAtDesignTime=   -1  'True
  10.    InvisibleAtRuntime=   -1  'True
  11.    MouseIcon       =   "SysTray.ctx":0000
  12.    Picture         =   "SysTray.ctx":030A
  13.    ScaleHeight     =   34
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   34
  16. End
  17. Attribute VB_Name = "cSysTray"
  18. Attribute VB_GlobalNameSpace = False
  19. Attribute VB_Creatable = True
  20. Attribute VB_PredeclaredId = False
  21. Attribute VB_Exposed = True
  22. Option Explicit
  23. '-------------------------------------------------------
  24. ' Control Property Globals...
  25. '-------------------------------------------------------
  26. Private gInTray As Boolean
  27. Private gTrayId As Long
  28. Private gTrayTip As String
  29. Private gTrayHwnd As Long
  30. Private gTrayIcon As StdPicture
  31. Private gAddedToTray As Boolean
  32. Const MAX_SIZE = 510
  33.  
  34. Private Const defInTray = False
  35. Private Const defTrayTip = "VB 5 - SysTray Control." & vbNullChar
  36.  
  37. Private Const sInTray = "InTray"
  38. Private Const sTrayIcon = "TrayIcon"
  39. Private Const sTrayTip = "TrayTip"
  40.  
  41. '-------------------------------------------------------
  42. ' Control Events...
  43. '-------------------------------------------------------
  44. Public Event MouseMove(Id As Long)
  45. Public Event MouseDown(Button As Integer, Id As Long)
  46. Public Event MouseUp(Button As Integer, Id As Long)
  47. Public Event MouseDblClick(Button As Integer, Id As Long)
  48.  
  49. '-------------------------------------------------------
  50. Private Sub UserControl_Initialize()
  51. '-------------------------------------------------------
  52.     gInTray = defInTray                             ' Set global InTray defalt
  53.     gAddedToTray = False                            ' Set default state
  54.     gTrayId = 0                                     ' Set global TrayId default
  55.     gTrayHwnd = hwnd                                ' Set and keep HWND of user control
  56. '-------------------------------------------------------
  57. End Sub
  58. '-------------------------------------------------------
  59.  
  60. '-------------------------------------------------------
  61. Private Sub UserControl_InitProperties()
  62. '-------------------------------------------------------
  63.     InTray = defInTray                              ' Init InTray Property
  64.     TrayTip = defTrayTip                            ' Init TrayTip Property
  65.     Set TrayIcon = Picture                          ' Init TrayIcon property
  66. '-------------------------------------------------------
  67. End Sub
  68. '-------------------------------------------------------
  69.  
  70. '-------------------------------------------------------
  71. Private Sub UserControl_Paint()
  72. '-------------------------------------------------------
  73.     Dim edge As RECT                                ' Rectangle edge of control
  74. '-------------------------------------------------------
  75.     edge.Left = 0                                   ' Set rect edges to outer
  76.     edge.Top = 0                                    ' - most position in pixels
  77.     edge.Bottom = ScaleHeight                       '
  78.     edge.Right = ScaleWidth                         '
  79.     DrawEdge hDC, edge, BDR_RAISEDOUTER, BF_RECT Or BF_SOFT ' Draw Edge...
  80. '-------------------------------------------------------
  81. End Sub
  82. '-------------------------------------------------------
  83.  
  84. '-------------------------------------------------------
  85. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  86. '-------------------------------------------------------
  87.     ' Read in the properties that have been saved into the PropertyBag...
  88.     With PropBag
  89.         InTray = .ReadProperty(sInTray, defInTray)       ' Get InTray
  90.         Set TrayIcon = .ReadProperty(sTrayIcon, Picture) ' Get TrayIcon
  91.         TrayTip = .ReadProperty(sTrayTip, defTrayTip)    ' Get TrayTip
  92.     End With
  93. '-------------------------------------------------------
  94. End Sub
  95. '-------------------------------------------------------
  96.  
  97. '-------------------------------------------------------
  98. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  99. '-------------------------------------------------------
  100.     With PropBag
  101.         .WriteProperty sInTray, gInTray                 ' Save InTray to propertybag
  102.         .WriteProperty sTrayIcon, gTrayIcon             ' Save TrayIcon to propertybag
  103.         .WriteProperty sTrayTip, gTrayTip               ' Save TrayTip to propertybag
  104.     End With
  105. '-------------------------------------------------------
  106. End Sub
  107. '-------------------------------------------------------
  108.  
  109. '-------------------------------------------------------
  110. Private Sub UserControl_Resize()
  111. '-------------------------------------------------------
  112.     Height = MAX_SIZE                   ' Prevent Control from being resized...
  113.     Width = MAX_SIZE
  114. '-------------------------------------------------------
  115. End Sub
  116. '-------------------------------------------------------
  117.  
  118. '-------------------------------------------------------
  119. Private Sub UserControl_Terminate()
  120. '-------------------------------------------------------
  121.     If InTray Then                      ' If TrayIcon is visible
  122.         InTray = False                  ' Cleanup and unplug it.
  123.     End If
  124. '-------------------------------------------------------
  125. End Sub
  126. '-------------------------------------------------------
  127.  
  128. '-------------------------------------------------------
  129. Public Property Set TrayIcon(Icon As StdPicture)
  130. '-------------------------------------------------------
  131.     Dim Tray As NOTIFYICONDATA                          ' Notify Icon Data structure
  132.     Dim rc As Long                                      ' API return code
  133. '-------------------------------------------------------
  134.     If Not (Icon Is Nothing) Then                       ' If icon is valid...
  135.         If (Icon.Type = vbPicTypeIcon) Then             ' Use ONLY if it is an icon
  136.             If gAddedToTray Then                        ' Modify tray only if it is in use.
  137.                 Tray.uID = gTrayId                      ' Unique ID for each HWND and callback message.
  138.                 Tray.hwnd = gTrayHwnd                   ' HWND receiving messages.
  139.                 Tray.hIcon = Icon.Handle                ' Tray icon.
  140.                 Tray.uFlags = NIF_ICON                  ' Set flags for valid data items
  141.                 Tray.cbSize = Len(Tray)                 ' Size of struct.
  142.                 
  143.                 rc = Shell_NotifyIcon(NIM_MODIFY, Tray) ' Send data to Sys Tray.
  144.             End If
  145.     
  146.             Set gTrayIcon = Icon                        ' Save Icon to global
  147.             Set Picture = Icon                          ' Show user change in control as well(gratuitous)
  148.             PropertyChanged sTrayIcon                   ' Notify control that property has changed.
  149.         End If
  150.     End If
  151. '-------------------------------------------------------
  152. End Property
  153. '-------------------------------------------------------
  154.  
  155. '-------------------------------------------------------
  156. Public Property Get TrayIcon() As StdPicture
  157. '-------------------------------------------------------
  158.     Set TrayIcon = gTrayIcon                        ' Return Icon value
  159. '-------------------------------------------------------
  160. End Property
  161. '-------------------------------------------------------
  162.  
  163. '-------------------------------------------------------
  164. Public Property Let TrayTip(Tip As String)
  165. Attribute TrayTip.VB_ProcData.VB_Invoke_PropertyPut = ";Misc"
  166. Attribute TrayTip.VB_UserMemId = -517
  167. '-------------------------------------------------------
  168.     Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
  169.     Dim rc As Long                                  ' API Return code
  170. '-------------------------------------------------------
  171.     If gAddedToTray Then                            ' if TrayIcon is in taskbar
  172.         Tray.uID = gTrayId                          ' Unique ID for each HWND and callback message.
  173.         Tray.hwnd = gTrayHwnd                       ' HWND receiving messages.
  174.         Tray.szTip = Tip & vbNullChar               ' Tray tool tip
  175.         Tray.uFlags = NIF_TIP                       ' Set flags for valid data items
  176.         Tray.cbSize = Len(Tray)                     ' Size of struct.
  177.         
  178.         rc = Shell_NotifyIcon(NIM_MODIFY, Tray)     ' Send data to Sys Tray.
  179.     End If
  180.     
  181.     gTrayTip = Tip                                  ' Save Tip
  182.     PropertyChanged sTrayTip                        ' Notify control that property has changed
  183. '-------------------------------------------------------
  184. End Property
  185. '-------------------------------------------------------
  186.  
  187. '-------------------------------------------------------
  188. Public Property Get TrayTip() As String
  189. '-------------------------------------------------------
  190.     TrayTip = gTrayTip                              ' Return Global Tip...
  191. '-------------------------------------------------------
  192. End Property
  193. '-------------------------------------------------------
  194.  
  195. '-------------------------------------------------------
  196. Public Property Let InTray(Show As Boolean)
  197. Attribute InTray.VB_ProcData.VB_Invoke_PropertyPut = ";Behavior"
  198. '-------------------------------------------------------
  199.     Dim ClassAddr As Long                           ' Address pointer to Control Instance
  200. '-------------------------------------------------------
  201.     If (Show <> gInTray) Then                       ' Modify ONLY if state is changing!
  202.         If Show Then                                ' If adding Icon to system tray...
  203.             If Ambient.UserMode Then                ' If in RunMode and not in IDE...
  204.                  ' SubClass Controls window proc.
  205.                 PrevWndProc = SetWindowLong(gTrayHwnd, GWL_WNDPROC, AddressOf SubWndProc)
  206.                 
  207.                 ' Get address to user control object
  208.                 'CopyMemory ClassAddr, UserControl, 4&
  209.                 
  210.                 ' Save address to the USERDATA of the control's window struct.
  211.                 ' this will be used to get an object refenence to the control
  212.                 ' from an HWND in the callback.
  213.                 SetWindowLong gTrayHwnd, GWL_USERDATA, ObjPtr(Me) 'ClassAddr
  214.                 
  215.                 AddIcon gTrayHwnd, gTrayId, TrayTip, TrayIcon ' Add TrayIcon to System Tray...
  216.                 gAddedToTray = True                 ' Save state of control used in teardown procedure
  217.             End If
  218.         Else                                        ' If removing Icon from system tray
  219.             If gAddedToTray Then                    ' If Added to system tray then remove...
  220.                 DeleteIcon gTrayHwnd, gTrayId       ' Remove icon from system tray
  221.                 
  222.                 ' Un SubClass controls window proc.
  223.                 SetWindowLong gTrayHwnd, GWL_WNDPROC, PrevWndProc
  224.                 gAddedToTray = False                ' Maintain the state for teardown purposes
  225.             End If
  226.         End If
  227.         
  228.         gInTray = Show                              ' Update global variable
  229.         PropertyChanged sInTray                     ' Notify control that property has changed
  230.     End If
  231. '-------------------------------------------------------
  232. End Property
  233. '-------------------------------------------------------
  234.  
  235. '-------------------------------------------------------
  236. Public Property Get InTray() As Boolean
  237. '-------------------------------------------------------
  238.     InTray = gInTray                                ' Return global property
  239. '-------------------------------------------------------
  240. End Property
  241. '-------------------------------------------------------
  242.  
  243. '-------------------------------------------------------
  244. Private Sub AddIcon(hwnd As Long, Id As Long, Tip As String, Icon As StdPicture)
  245. '-------------------------------------------------------
  246.     Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
  247.     Dim tFlags As Long                              ' Tray action flag
  248.     Dim rc As Long                                  ' API return code
  249. '-------------------------------------------------------
  250.     Tray.uID = Id                                   ' Unique ID for each HWND and callback message.
  251.     Tray.hwnd = hwnd                                ' HWND receiving messages.
  252.     
  253.     If Not (Icon Is Nothing) Then                   ' Validate Icon picture
  254.         Tray.hIcon = Icon.Handle                    ' Tray icon.
  255.         Tray.uFlags = Tray.uFlags Or NIF_ICON       ' Set ICON flag to validate data item
  256.         Set gTrayIcon = Icon                        ' Save icon
  257.     End If
  258.     
  259.     If (Tip <> "") Then                             ' Validate Tip text
  260.         Tray.szTip = Tip & vbNullChar               ' Tray tool tip
  261.         Tray.uFlags = Tray.uFlags Or NIF_TIP        ' Set TIP flag to validate data item
  262.         gTrayTip = Tip                              ' Save tool tip
  263.     End If
  264.     
  265.     Tray.uCallbackMessage = TRAY_CALLBACK           ' Set user defigned message
  266.     Tray.uFlags = Tray.uFlags Or NIF_MESSAGE        ' Set flags for valid data item
  267.     Tray.cbSize = Len(Tray)                         ' Size of struct.
  268.     
  269.     rc = Shell_NotifyIcon(NIM_ADD, Tray)            ' Send data to Sys Tray.
  270. '-------------------------------------------------------
  271. End Sub
  272. '-------------------------------------------------------
  273.  
  274. '-------------------------------------------------------
  275. Private Sub DeleteIcon(hwnd As Long, Id As Long)
  276. '-------------------------------------------------------
  277.     Dim Tray As NOTIFYICONDATA                      ' Notify Icon Data structure
  278.     Dim rc As Long                                  ' API return code
  279. '-------------------------------------------------------
  280.     Tray.uID = Id                                   ' Unique ID for each HWND and callback message.
  281.     Tray.hwnd = hwnd                                ' HWND receiving messages.
  282.     Tray.uFlags = 0&                                ' Set flags for valid data items
  283.     Tray.cbSize = Len(Tray)                         ' Size of struct.
  284.     
  285.     rc = Shell_NotifyIcon(NIM_DELETE, Tray)         ' Send delete message.
  286. '-------------------------------------------------------
  287. End Sub
  288. '-------------------------------------------------------
  289.  
  290. '-------------------------------------------------------
  291. Friend Sub SendEvent(MouseEvent As Long, Id As Long)
  292. '-------------------------------------------------------
  293.     Select Case MouseEvent                          ' Dispatch mouse events to control
  294.     Case WM_MOUSEMOVE
  295.         RaiseEvent MouseMove(Id)
  296.     Case WM_LBUTTONDOWN
  297.         RaiseEvent MouseDown(vbLeftButton, Id)
  298.     Case WM_LBUTTONUP
  299.         RaiseEvent MouseUp(vbLeftButton, Id)
  300.     Case WM_LBUTTONDBLCLK
  301.         RaiseEvent MouseDblClick(vbLeftButton, Id)
  302.     Case WM_RBUTTONDOWN
  303.         RaiseEvent MouseDown(vbRightButton, Id)
  304.     Case WM_RBUTTONUP
  305.         RaiseEvent MouseUp(vbRightButton, Id)
  306.     Case WM_RBUTTONDBLCLK
  307.         RaiseEvent MouseDblClick(vbRightButton, Id)
  308.     End Select
  309. '-------------------------------------------------------
  310. End Sub
  311. '-------------------------------------------------------
  312.  
  313.