home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / MenuBar_co2132961122008.psc / Classes / clsMenuItems.cls < prev    next >
Text File  |  2008-01-20  |  4KB  |  137 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 = "clsMenuItems"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. ' Private Variables
  17. Private NewMenuItem         As clsMenuItem
  18. Private m_ItemsShowed       As Integer
  19. Private MenuItemsCollection As New Collection
  20.  
  21. Public Property Get ItemsShowed() As Integer
  22.  
  23.    ItemsShowed = m_ItemsShowed
  24.  
  25. End Property
  26.  
  27. Public Property Let ItemsShowed(ByVal NewItemsShowed As Integer)
  28.  
  29.    m_ItemsShowed = NewItemsShowed
  30.  
  31. End Property
  32.  
  33. Public Function Add(ByVal Caption As String, ByVal Index As Integer, ByVal ButtonHeight As Long, ByRef picIcon As StdPicture) As clsMenuItem
  34.  
  35.    Set NewMenuItem = New clsMenuItem
  36.    
  37.    With NewMenuItem
  38.       .Caption = Caption
  39.       .Index = Index
  40.       .ButtonHeight = ButtonHeight
  41.       Set .Icon = picIcon
  42.    End With
  43.    
  44.    With MenuItemsCollection
  45.       If (.Count = 0) Or (Index = .Count + 1) Then
  46.          .Add NewMenuItem
  47.          
  48.       ElseIf Index = 1 Then
  49.          .Add NewMenuItem, , 1
  50.          
  51.       Else
  52.          .Add NewMenuItem, , , Index - 1
  53.       End If
  54.    End With
  55.    
  56.    Set Add = NewMenuItem
  57.    Set NewMenuItem = Nothing
  58.  
  59. End Function
  60.  
  61. Public Function Count() As Integer
  62.  
  63.    Count = MenuItemsCollection.Count
  64.  
  65. End Function
  66.  
  67. Public Function Item(ByVal Index As Integer) As clsMenuItem
  68.  
  69.    Set Item = MenuItemsCollection.Item(Index)
  70.  
  71. End Function
  72.  
  73. Public Function MouseProcess(ByVal MousePosition As Long, ByVal X As Long, ByVal Y As Long) As Integer
  74.  
  75. Static intPrevDown As Integer
  76.  
  77. Dim clsMenuItems   As clsMenuItem
  78.  
  79.    For Each clsMenuItems In MenuItemsCollection
  80.       With clsMenuItems
  81.          If .HitTest(MousePosition, X, Y) Then
  82.             If MousePosition = MOUSE_UP Then
  83.                If intPrevDown = .Index Then MouseProcess = .Index
  84.                
  85.             Else
  86.                MouseProcess = .Index
  87.             End If
  88.             
  89.             If MousePosition = MOUSE_DOWN Then intPrevDown = .Index
  90.          End If
  91.       End With
  92.    Next 'clsMenuItems
  93.    
  94.    Set clsMenuItems = Nothing
  95.  
  96. End Function
  97.  
  98. Public Function Paint(ByVal TopMenuItem As Integer, ByVal FirstIcon As Long, ByVal CurrentMenu As Integer, ByVal ClipHeight As Long, ByVal ItemIconSize As Integer, ByVal OnlyFullItemsShow As Boolean, ByVal OnlyFullItemsHit As Boolean, ByVal ButtonHideInSingleMenu As Boolean) As Boolean
  99.  
  100. Dim blnIsShowed  As Boolean
  101. Dim clsMenuItems As clsMenuItem
  102.  
  103.    For Each clsMenuItems In MenuItemsCollection
  104.       With clsMenuItems
  105.          If .Index < TopMenuItem Then
  106.             .DisableButton
  107.             
  108.          Else
  109.             Paint = .PaintButton(TopMenuItem, FirstIcon, CurrentMenu, ClipHeight, ItemIconSize, OnlyFullItemsShow, OnlyFullItemsHit, ButtonHideInSingleMenu, blnIsShowed)
  110.             m_ItemsShowed = m_ItemsShowed + Abs(blnIsShowed)
  111.          End If
  112.       End With
  113.    Next 'clsMenuItems
  114.    
  115.    Set clsMenuItems = Nothing
  116.  
  117. End Function
  118.  
  119. Public Sub Delete(ByVal Index As Integer)
  120.  
  121.    MenuItemsCollection.Remove Index
  122.  
  123. End Sub
  124.  
  125. Private Sub Class_Initialize()
  126.  
  127.    Set MenuItemsCollection = New Collection
  128.  
  129. End Sub
  130.  
  131. Private Sub Class_Terminate()
  132.  
  133.    Set NewMenuItem = Nothing
  134.    Set MenuItemsCollection = Nothing
  135.  
  136. End Sub
  137.