home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / sgwnd10 / TRAYICON.CLS < prev    next >
Encoding:
Visual Basic class definition  |  1998-09-16  |  8.5 KB  |  298 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "TrayIcon"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. '--------------------------------------------------------------------------
  11. ' This file is part of the SG Window
  12. '
  13. ' Class TrayIcon shows how to use SGWindow to add VB program
  14. ' to the system tray.
  15. '
  16. ' USAGE:
  17. '
  18. ' Copyright ⌐ 1998 Stinga
  19. ' All rights reserved
  20. '
  21. ' You have a right to use and modify this code. However, Stinga
  22. ' takes no responsibility for what you may do with this or any
  23. ' modification of this code.
  24. '--------------------------------------------------------------------------
  25. Option Explicit
  26.  
  27. ' API declarations
  28. Private Const NIM_ADD = &H0
  29. Private Const NIM_DELETE = &H2
  30. Private Const NIM_MODIFY = &H1
  31. Private Const NIF_MESSAGE = &H1
  32. Private Const NIF_ICON = &H2
  33. Private Const NIF_TIP = &H4
  34.  
  35. Private Type NOTIFYICONDATA
  36.    cbSize As Long
  37.    hWnd As Long
  38.    uID As Long
  39.    uFlags As Long
  40.    uCallbackMessage As Long
  41.    hIcon As Long
  42.    szTip As String * 64
  43. End Type
  44.  
  45. Private Type POINTAPI
  46.    x As Long
  47.    y As Long
  48. End Type
  49.  
  50. Private Type RECT
  51.    Left As Long
  52.    Top As Long
  53.    Right As Long
  54.    Bottom As Long
  55. End Type
  56.  
  57. Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
  58. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  59. Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
  60. 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
  61. 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
  62.  
  63.  
  64. ' Message callback interface
  65. Implements sgWindow.IsgMessageSink
  66.  
  67. ' Private constants and variables
  68. Private Const CallbackMessage = &H8001&
  69. Private mWnd As sgWindow.Window  ' SG Window object
  70. Private mNID As NOTIFYICONDATA   ' Comunication structure
  71. Private mIcon As Object          ' Tray icon image
  72. Private mbAdded As Boolean       ' True if icon is on the system tray
  73. Private mbEnabled As Boolean     ' True if tray icon fires events in responds to mouse messages
  74. Private mFrm As Object           ' Associated form
  75. Private mPopupMenu As Object     ' Popup menu
  76. Private mbRaisePopupMenuEvent As Boolean ' True if popup menu event should be fired
  77.  
  78.  
  79. ' Event declaration
  80. Event PopupMenu(ByVal x As Single, ByVal y As Single)
  81. Event MouseMove(ByVal x As Single, ByVal y As Single)
  82. Event Click(ByVal x As Single, ByVal y As Single)
  83. Event DblClick(ByVal x As Single, ByVal y As Single)
  84. Event LButtonDown(ByVal x As Single, ByVal y As Single)
  85. Event LButtonUp(ByVal x As Single, ByVal y As Single)
  86. Event MButtonDown(ByVal x As Single, ByVal y As Single)
  87. Event MButtonUp(ByVal x As Single, ByVal y As Single)
  88. Event RButtonDown(ByVal x As Single, ByVal y As Single)
  89. Event RButtonUp(ByVal x As Single, ByVal y As Single)
  90.  
  91.  
  92. '--------------------------------------------------------------------------
  93. ' Class interface methods
  94. '--------------------------------------------------------------------------
  95. Public Property Set Form(frm As Object)
  96.    Set mFrm = frm
  97. End Property
  98.  
  99. Public Property Get Enabled() As Boolean
  100.    Enabled = mbEnabled
  101. End Property
  102.  
  103. Public Property Let Enabled(val As Boolean)
  104.    mbEnabled = val
  105. End Property
  106.  
  107. Public Property Set PopupMenu(mnu As Object)
  108.    Set mPopupMenu = mnu
  109. End Property
  110.  
  111. Public Property Get Tip() As String
  112.    Tip = mNID.szTip
  113. End Property
  114.  
  115. Public Property Let Tip(sTip As String)
  116.     mNID.szTip = IIf(Len(sTip) > 63, Left(sTip, 63), sTip) & vbNullChar
  117.     Modify NIF_TIP
  118. End Property
  119.  
  120. Public Property Get Icon() As Object
  121.    Set Icon = mIcon
  122. End Property
  123.  
  124. Public Property Set Icon(ic As Object)
  125.    Set mIcon = ic
  126.    mNID.hIcon = mIcon.Handle
  127.    Modify NIF_ICON
  128. End Property
  129.  
  130. Public Sub Add()
  131.    If Not mbAdded Then
  132.       mNID.uFlags = NIF_TIP + NIF_MESSAGE
  133.       
  134.       ' Do we have icon image
  135.       If mIcon.Handle <> 0 And mIcon.Type = vbPicTypeIcon Then
  136.          mNID.hIcon = mIcon.Handle
  137.          mNID.uFlags = mNID.uFlags + NIF_ICON
  138.       End If
  139.       
  140.       ' Add icon to the system tray
  141.       Dim rc As Long
  142.       rc = Shell_NotifyIcon(NIM_ADD, mNID)
  143.       If rc <> 0 Then
  144.          ' OK
  145.          mbAdded = True
  146.       Else
  147.          ' Icon was not added
  148.          mbAdded = False
  149.          Err.Raise vbError + 1, "SGTrayIcon", "Failed to add icon to the system try"
  150.       End If
  151.    End If
  152. End Sub
  153.  
  154. Public Sub Remove()
  155.    If mbAdded Then
  156.       Shell_NotifyIcon NIM_DELETE, mNID
  157.       mbAdded = False
  158.    End If
  159. End Sub
  160.  
  161. '--------------------------------------------------------------------------
  162. ' Class implementation methods
  163. '--------------------------------------------------------------------------
  164. Private Sub Modify(what As Long)
  165.    Dim rc&
  166.    
  167.    mNID.uFlags = what
  168.    rc = Shell_NotifyIcon(NIM_MODIFY, mNID)
  169.    If rc = 0 Then
  170.    End If
  171. End Sub
  172.  
  173. Private Sub Class_Initialize()
  174.  
  175.    mbAdded = False
  176.    mbRaisePopupMenuEvent = True
  177.    mbEnabled = True
  178.    
  179.    ' Create SG Window object
  180.    Set mWnd = New sgWindow.Window
  181.    
  182.    ' Create hidden window that will receive tray icon messages
  183.    mWnd.Create "STATIC", "SG Window TrayIcon Helper", 0, 0, _
  184.                10, 10, 100, 20, 0, 0
  185.                
  186.    ' Hook callback message
  187.    mWnd.EnableMessage CallbackMessage, True
  188.    mWnd.SetMessageCallback Me
  189.    mWnd.Hooked = True
  190.    
  191.    ' Initialize tray icon structure
  192.    mNID.cbSize = Len(mNID)
  193.    mNID.hWnd = mWnd.hWnd
  194.    mNID.uID = 1
  195.    mNID.uFlags = 0
  196.    mNID.uCallbackMessage = CallbackMessage
  197.    mNID.hIcon = 0
  198.    mNID.szTip = ""
  199. End Sub
  200.  
  201. Private Sub Class_Terminate()
  202.    ' Remove icon from the system try
  203.    Remove
  204.    
  205.    ' Destroy hidden window
  206.    mWnd.Hooked = False
  207.    mWnd.Destroy
  208.    
  209.    Set mFrm = Nothing
  210. End Sub
  211.  
  212. '--------------------------------------------------------------------------
  213. ' System tray message handler
  214. '--------------------------------------------------------------------------
  215. Private Sub IsgMessageSink_Message(ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, result As Long)
  216.    
  217.    '
  218.    ' This is place where we catch messages sent by system tray.
  219.    '
  220.    ' wParam = icon identifier. We have only one icon per window,
  221.    '          so we do not need this information.
  222.    ' lParam = mouse message code
  223.    '
  224.    
  225.    If Not mbEnabled Then
  226.       result = mWnd.CallWindowProc(msg, wParam, lParam)
  227.       Exit Sub
  228.    End If
  229.    
  230.    Dim pt As POINTAPI
  231.    Call GetCursorPos(pt)
  232.    
  233.    Select Case lParam
  234.       Case wm_MOUSEMOVE
  235.          ' Mouse Move event
  236.          RaiseEvent MouseMove(pt.x, pt.y)
  237.          
  238.       Case wm_LBUTTONDBLCLK
  239.          ' Double click event
  240.          RaiseEvent DblClick(pt.x, pt.y)
  241.          
  242.       Case wm_LBUTTONDOWN
  243.          ' Button down event
  244.          RaiseEvent LButtonDown(pt.x, pt.y)
  245.    
  246.       Case wm_LBUTTONUP
  247.          ' Button up event
  248.          RaiseEvent LButtonUp(pt.x, pt.y)
  249.          RaiseEvent Click(pt.x, pt.y)
  250.          
  251.       Case wm_MBUTTONDBLCLK
  252.          ' Double click event
  253.          RaiseEvent DblClick(pt.x, pt.y)
  254.          
  255.       Case wm_MBUTTONDOWN
  256.          ' Button down event
  257.          RaiseEvent MButtonDown(pt.x, pt.y)
  258.    
  259.       Case wm_MBUTTONUP
  260.          ' Button up event
  261.          RaiseEvent MButtonUp(pt.x, pt.y)
  262.          RaiseEvent Click(pt.x, pt.y)
  263.          
  264.       Case wm_RBUTTONDBLCLK
  265.          ' Double click event
  266.          RaiseEvent DblClick(pt.x, pt.y)
  267.          
  268.       Case wm_RBUTTONDOWN
  269.          ' Button down event
  270.          RaiseEvent RButtonDown(pt.x, pt.y)
  271.          
  272.          ' Pop up menu event
  273.          Dim hWnd&
  274.          hWnd = 0
  275.          If Not mFrm Is Nothing Then
  276.             hWnd = mFrm.hWnd
  277.             Call SetForegroundWindow(hWnd)
  278.          End If
  279.          If mPopupMenu Is Nothing Then
  280.             RaiseEvent PopupMenu(pt.x, pt.y)
  281.          ElseIf Not mFrm Is Nothing Then
  282.             mFrm.PopupMenu mPopupMenu
  283.          End If
  284.          If hWnd <> 0 Then _
  285.             Call PostMessage(hWnd, wm_NULL, 0, 0)
  286.          
  287.       Case wm_RBUTTONUP
  288.          ' Button up event
  289.          RaiseEvent RButtonUp(pt.x, pt.y)
  290.          RaiseEvent Click(pt.x, pt.y)
  291.          
  292.       Case Else
  293.          ' Default processing
  294.          result = mWnd.CallWindowProc(msg, wParam, lParam)
  295.    End Select
  296. End Sub
  297.  
  298.