home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / VertMenu.exe / MenuItems.cls < prev    next >
Encoding:
Visual Basic class definition  |  1997-02-12  |  4.1 KB  |  118 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "MenuItems"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. Dim colMenuItems As New Collection
  13. Const MOUSE_UP = 1
  14. Const MOUSE_DOWN = -1
  15. Const MOUSE_MOVE = 0
  16.  
  17. ' add a new MenuItem to the collection
  18. ' Parameters:   sCaption        Caption of the MenuItem
  19. '               lIndex          Location of the MenuItem in MenuItems collection
  20. '               picIcon         Icon
  21. Public Function Add(ByVal sCaption As String, lIndex As Long, lButtonHeight As Long, picIcon As Object) As MenuItem
  22.     Dim newMenuItem As New MenuItem
  23.     
  24.     On Error Resume Next
  25.     With newMenuItem
  26.         .Caption = sCaption
  27.         .Index = lIndex
  28.         .ButtonHeight = lButtonHeight
  29.         Set .Button = picIcon
  30.             
  31.         ' add the item to the collection specified by lIndex
  32.         ' note, if there is nothing in the collection, just add it
  33.         ' if there is nothing in the collection or we are adding it at then end, just add it
  34.         ' elseif we are inserting in the first position, add it BEFORE
  35.         ' else add it AFTER the previous item
  36.         If colMenuItems.Count = 0 Or lIndex = colMenuItems.Count + 1 Then
  37.             colMenuItems.Add newMenuItem
  38.         ElseIf lIndex = 1 Then
  39.             colMenuItems.Add newMenuItem, , 1
  40.         Else
  41.             colMenuItems.Add newMenuItem, , , lIndex - 1
  42.         End If
  43.     End With
  44.     
  45.     Set Add = newMenuItem
  46. End Function
  47.  
  48. ' delete the MenuItem from the collection
  49. ' Parameters:       lIndex  Index of the collection member
  50. Public Sub Delete(lIndex As Long)
  51.     On Error Resume Next
  52.     colMenuItems.Remove lIndex
  53. End Sub
  54.  
  55. ' return the object of the MenuItem in the collection
  56. ' Parameters:       lIndex  Index of the collection member
  57. Public Function Item(lIndex As Long) As MenuItem
  58.     On Error Resume Next
  59.     Set Item = colMenuItems.Item(lIndex)
  60. End Function
  61.  
  62. ' return the number of MenuItems in the collection
  63. Public Function Count() As Long
  64.     On Error Resume Next
  65.     Count = colMenuItems.Count
  66. End Function
  67.  
  68. ' paint all MenuItems (icon & caption) in this collection
  69. ' Parameters:       bRecalc
  70. '                       True    Forces a recalc of the icon's position
  71. '                       False   Uses the current icon position
  72. Public Function Paint(lTopMenuItemDisplayed As Long, lIconStart As Long, lMenuCur As Long, lClipY As Long) As Boolean
  73.     Dim MenuItem As MenuItem
  74.     
  75.     For Each MenuItem In colMenuItems
  76.         With MenuItem
  77.             'If .Index >= lTopMenuItemDisplayed Then
  78.             Paint = .PaintButton(lTopMenuItemDisplayed, lIconStart, lMenuCur, lClipY)
  79.             'End If
  80.         End With
  81.     Next
  82. End Function
  83.  
  84. ' process mouse events for all MenuItems in the collection
  85. Public Function MouseProcess(ByVal iMousePosition, ByVal x As Long, ByVal y As Long) As Long
  86.     Dim MenuItem As MenuItem
  87.     Dim bResult As Boolean
  88.     Dim lIndex As Long
  89.     Static lLastDown As Long
  90.     
  91.     On Error Resume Next
  92.     For Each MenuItem In colMenuItems
  93.         With MenuItem
  94.             bResult = .HitTest(iMousePosition, x, y)
  95.             
  96.             ' the mouse can only be over one object at a time (they don't overlap)
  97.             ' if we get a hit, set MouseProcess to return to the calling routine
  98.             ' we need to remember where the mouse went down because if the user
  99.             ' moves the mouse and raises on another item, we don't want to fire the event
  100.             lIndex = .Index
  101.             If bResult Then
  102.                 Select Case iMousePosition
  103.                     Case MOUSE_UP
  104.                         If lLastDown = lIndex Then
  105.                             MouseProcess = lIndex
  106.                         End If
  107.                     Case Else
  108.                         MouseProcess = lIndex
  109.                 End Select
  110.                 If iMousePosition = MOUSE_DOWN Then
  111.                     lLastDown = lIndex
  112.                 End If
  113.             End If
  114.         End With
  115.     Next
  116. End Function
  117.  
  118.