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 / clsMenus.cls < prev   
Text File  |  2008-01-20  |  21KB  |  746 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 = "clsMenus"
  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 Constants
  17. Private Const PIXELS_PER_BITBLT  As Integer = 1
  18.  
  19. ' Private Variables
  20. Private m_CaptionAlignment       As AlignmentConstants
  21. Private m_ItemAlignment          As AlignmentConstants
  22. Private m_IconAlignment          As Alignments
  23. Private m_Animation              As Boolean
  24. Private m_ButtonHideInSingleMenu As Boolean
  25. Private m_FontBoldButtonCaption  As Boolean
  26. Private m_FontBoldItemCaption    As Boolean
  27. Private m_NumberOfMenusChanged   As Boolean
  28. Private m_OnlyFullItemsHit       As Boolean
  29. Private m_OnlyFullItemsShow      As Boolean
  30. Private m_SoundItemScroll        As Boolean
  31. Private m_CurrentMenu            As Integer
  32. Private m_ItemIconSize           As Integer
  33. Private m_ItemsShowed            As Integer
  34. Private PreviousMenu             As Integer
  35. Private m_ButtonHeight           As Long
  36. Private m_ForeColor              As Long
  37. Private m_Menus                  As New Collection
  38. Private picCache                 As PictureBox
  39. Private picMenu                  As PictureBox
  40.  
  41. ' Private API
  42. Private Declare Function StretchBlt Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  43.  
  44. Public Property Get Animation() As Boolean
  45.  
  46.    Animation = m_Animation
  47.  
  48. End Property
  49.  
  50. Public Property Let Animation(ByVal NewAnimation As Boolean)
  51.  
  52.    m_Animation = NewAnimation
  53.  
  54. End Property
  55.  
  56. Public Property Get ButtonHideInSingleMenu() As Boolean
  57.  
  58.    ButtonHideInSingleMenu = m_ButtonHideInSingleMenu
  59.  
  60. End Property
  61.  
  62. Public Property Let ButtonHideInSingleMenu(ByVal NewButtonHideInSingleMenu As Boolean)
  63.  
  64.    m_ButtonHideInSingleMenu = NewButtonHideInSingleMenu
  65.  
  66. End Property
  67.  
  68. Public Property Get CaptionAlignment() As AlignmentConstants
  69.  
  70.    CaptionAlignment = m_CaptionAlignment
  71.  
  72. End Property
  73.  
  74. Public Property Let CaptionAlignment(ByVal NewCaptionAlignment As AlignmentConstants)
  75.  
  76.    m_CaptionAlignment = NewCaptionAlignment
  77.  
  78. End Property
  79.  
  80. Public Property Let CurrentMenu(ByVal NewCurrentMenu As Long)
  81.  
  82.    m_CurrentMenu = NewCurrentMenu
  83.  
  84. End Property
  85.  
  86. Public Property Get FontBoldButtonCaption() As Boolean
  87.  
  88.    FontBoldButtonCaption = m_FontBoldButtonCaption
  89.  
  90. End Property
  91.  
  92. Public Property Let FontBoldButtonCaption(ByVal NewFontBoldButtonText As Boolean)
  93.  
  94.    m_FontBoldButtonCaption = NewFontBoldButtonText
  95.  
  96. End Property
  97.  
  98. Public Property Get FontBoldItemCaption() As Boolean
  99.  
  100.    FontBoldItemCaption = m_FontBoldItemCaption
  101.  
  102. End Property
  103.  
  104. Public Property Let FontBoldItemCaption(ByVal NewFontBoldItemCaption As Boolean)
  105.  
  106.    m_FontBoldItemCaption = NewFontBoldItemCaption
  107.  
  108. End Property
  109.  
  110. Public Property Let ForeColor(ByVal NewForeColor As Long)
  111.  
  112.    m_ForeColor = NewForeColor
  113.  
  114. End Property
  115.  
  116. Public Property Let ButtonHeight(ByVal NewButtonHeight As Long)
  117.  
  118.    m_ButtonHeight = NewButtonHeight
  119.  
  120. End Property
  121.  
  122. Public Property Set Cache(ByRef NewCache As PictureBox)
  123.  
  124.    Set picCache = NewCache
  125.  
  126. End Property
  127.  
  128. Public Property Get Count() As Long
  129.  
  130.    Count = m_Menus.Count
  131.  
  132. End Property
  133.  
  134. Public Property Get IconAlignment() As Alignments
  135.  
  136.    IconAlignment = m_IconAlignment
  137.  
  138. End Property
  139.  
  140. Public Property Let IconAlignment(ByVal NewIconAlignment As Alignments)
  141.  
  142.    m_IconAlignment = NewIconAlignment
  143.  
  144. End Property
  145.  
  146. Public Property Get Item(ByVal NewIndex As Integer) As clsMenu
  147.  
  148.    If NewIndex > 0 Then Set Item = m_Menus.Item(NewIndex)
  149.  
  150. End Property
  151.  
  152. Public Property Let ItemAlignment(ByVal NewItemAlignment As AlignmentConstants)
  153.  
  154.    m_ItemAlignment = NewItemAlignment
  155.  
  156. End Property
  157.  
  158. Public Property Let ItemIconSize(ByVal NewItemIconSize As Integer)
  159.  
  160.    m_ItemIconSize = NewItemIconSize
  161.  
  162. End Property
  163.  
  164. Public Property Get ItemsShowed() As Integer
  165.  
  166.    ItemsShowed = m_ItemsShowed
  167.  
  168. End Property
  169.  
  170. Public Property Set Menu(ByRef NewMenu As PictureBox)
  171.  
  172.    Set picMenu = NewMenu
  173.  
  174. End Property
  175.  
  176. Public Property Get MenuItems(ByVal SelectedMenu As Integer) As Integer
  177.  
  178.    MenuItems = m_Menus.Item(SelectedMenu).MenuItemCount
  179.  
  180. End Property
  181.  
  182. Public Property Let NumberOfMenusChanged(ByVal NewNumberOfMenusChanged As Boolean)
  183.  
  184.    m_NumberOfMenusChanged = NewNumberOfMenusChanged
  185.  
  186. End Property
  187.  
  188. Public Property Get OnlyFullItemsHit() As Boolean
  189.  
  190.    OnlyFullItemsHit = m_OnlyFullItemsHit
  191.  
  192. End Property
  193.  
  194. Public Property Let OnlyFullItemsHit(ByVal NewOnlyFullItemsHit As Boolean)
  195.  
  196.    m_OnlyFullItemsHit = NewOnlyFullItemsHit
  197.  
  198. End Property
  199.  
  200. Public Property Get OnlyFullItemsShow() As Boolean
  201.  
  202.    OnlyFullItemsShow = m_OnlyFullItemsShow
  203.  
  204. End Property
  205.  
  206. Public Property Let OnlyFullItemsShow(ByVal NewOnlyFullItemsShow As Boolean)
  207.  
  208.    m_OnlyFullItemsShow = NewOnlyFullItemsShow
  209.  
  210. End Property
  211.  
  212. Public Property Get SoundItemScroll() As Boolean
  213.  
  214.    SoundItemScroll = m_SoundItemScroll
  215.  
  216. End Property
  217.  
  218. Public Property Let SoundItemScroll(ByVal NewSoundItemScroll As Boolean)
  219.  
  220.    m_SoundItemScroll = NewSoundItemScroll
  221.  
  222. End Property
  223.  
  224. Public Property Get TopItem() As Integer
  225.  
  226.    TopItem = m_Menus.Item(m_CurrentMenu).TopMenuItem
  227.  
  228. End Property
  229.  
  230. Public Property Get TotalMenuItems() As Integer
  231.  
  232. Dim clsMenus As clsMenu
  233.  
  234.    For Each clsMenus In m_Menus
  235.       TotalMenuItems = TotalMenuItems + clsMenus.MenuItemCount
  236.    Next 'clsMenus
  237.    
  238.    Set clsMenus = Nothing
  239.  
  240. End Property
  241.  
  242. Public Function Add(ByVal Caption As String, ByVal Index As Integer, ByRef picMenu As PictureBox) As clsMenu
  243.  
  244. Dim clsNewMenu As New clsMenu
  245.  
  246.    With clsNewMenu
  247.       .Caption = Caption
  248.       .Index = Index
  249.       Set .Control = picMenu
  250.       .ButtonHeight = m_ButtonHeight
  251.    End With
  252.    
  253.    With m_Menus
  254.       If .Count = 0 Then
  255.          .Add clsNewMenu
  256.          
  257.       ElseIf Index = .Count + 1 Then
  258.          .Add clsNewMenu
  259.          
  260.       ElseIf Index = 1 Then
  261.          .Add clsNewMenu, , 1
  262.          
  263.       Else
  264.          .Add clsNewMenu, , , Index - 1
  265.       End If
  266.    End With
  267.    
  268.    Set Add = clsNewMenu
  269.    Set clsNewMenu = Nothing
  270.  
  271. End Function
  272.  
  273. Public Function MouseProcess(ByVal MousePosition As Long, ByVal X As Long, ByVal Y As Long, Optional ByRef HitType As Integer) As Integer
  274.  
  275. Const ARROW_DOWN        As Integer = 4
  276. Const ARROW_UP          As Integer = 5
  277. Const SOUND_ITEM_SCROLL As Integer = 2
  278.  
  279. Dim intResult           As Integer
  280.  
  281.    intResult = IsMenuButtonHitOrClicked(MousePosition, X, Y)
  282.    
  283.    If intResult Then
  284.       HitType = HIT_TYPE_MENU_BUTTON
  285.       MouseProcess = intResult
  286.       Exit Function
  287.       
  288.    Else
  289.       intResult = m_Menus.Item(m_CurrentMenu).MenuItems.MouseProcess(MousePosition, X, Y)
  290.       
  291.       If intResult Then
  292.          picMenu.ToolTipText = m_Menus.Item(m_CurrentMenu).MenuItems.Item(intResult).ToolTipText
  293.          HitType = HIT_TYPE_MENU_ITEM
  294.          
  295.          If MousePosition = MOUSE_UP Then MouseProcess = intResult
  296.       End If
  297.    End If
  298.    
  299.    intResult = m_Menus.Item(m_CurrentMenu).MouseProcessForArrows(MousePosition, X, Y)
  300.    
  301.    If intResult Then
  302.       If intResult = HIT_TYPE_ARROW Then
  303.          HitType = HIT_TYPE_ARROW
  304.          MouseProcess = HitType
  305.          
  306.       ElseIf intResult = SCROLL_UP Then
  307.          Call ScrollUp
  308.          
  309.          If m_SoundItemScroll Then Call PlaySound(SOUND_ITEM_SCROLL)
  310.          
  311.          HitType = ARROW_UP
  312.          
  313.       ' SCROLL_DOWN
  314.       Else
  315.          Call ScrollDown
  316.          
  317.          If m_SoundItemScroll Then Call PlaySound(SOUND_ITEM_SCROLL)
  318.          
  319.          HitType = ARROW_DOWN
  320.       End If
  321.    End If
  322.  
  323. End Function
  324.  
  325. Public Sub Delete(ByVal Index As Integer)
  326.  
  327.    m_Menus.Remove Index
  328.  
  329. End Sub
  330.  
  331. Public Sub MoveToItem(ByVal Moves As Integer)
  332.  
  333.    If Moves < 0 Then
  334.       For Moves = Abs(Moves) To 1 Step -1
  335.          Call ScrollUp
  336.       Next 'Moves
  337.       
  338.    Else
  339.       For Moves = 1 To Moves
  340.          Call ScrollDown
  341.       Next 'Moves
  342.    End If
  343.  
  344. End Sub
  345.  
  346. Public Sub Paint()
  347.  
  348.    If PreviousMenu = 0 Then PreviousMenu = m_CurrentMenu
  349.    
  350.    If PreviousMenu = m_CurrentMenu Then
  351.       Call RePaint
  352.       
  353.    ElseIf PreviousMenu < m_CurrentMenu Then
  354.       Call ReSelectDown
  355.       
  356.    Else
  357.       Call ReSelectUp
  358.    End If
  359.    
  360.    Call DrawItemIcon
  361.    Call SetButtonsHotSpot
  362.    
  363.    PreviousMenu = m_CurrentMenu
  364.  
  365. End Sub
  366.  
  367. Public Sub RestoreButton(ByVal MousePosition As Long, ByVal X As Long, ByVal Y As Long)
  368.  
  369.    IsMenuButtonHitOrClicked MousePosition, X, Y
  370.  
  371. End Sub
  372.  
  373. Private Function AlignCaption(ByVal CaptionWidth As Long, ByVal ButtonWidth As Long) As Long
  374.  
  375.    If m_CaptionAlignment = vbLeftJustify Then
  376.       AlignCaption = 5
  377.       
  378.    ElseIf m_CaptionAlignment = vbRightJustify Then
  379.       AlignCaption = ButtonWidth - CaptionWidth - 5
  380.       
  381.    ' vbCenter
  382.    Else
  383.       AlignCaption = (ButtonWidth - CaptionWidth) \ 2
  384.    End If
  385.  
  386. End Function
  387.  
  388. Private Function ClipHeight() As Long
  389.  
  390.    ClipHeight = picMenu.ScaleHeight - (m_Menus.Count - m_CurrentMenu) * m_ButtonHeight
  391.  
  392. End Function
  393.  
  394. Private Function FirstIcon() As Long
  395.  
  396. Dim intMenu As Integer
  397.  
  398.    For intMenu = 1 To m_CurrentMenu - 1
  399.       FirstIcon = FirstIcon + m_Menus.Item(intMenu).MenuItemCount
  400.    Next 'intMenu
  401.    
  402.    FirstIcon = FirstIcon + m_Menus.Item(m_CurrentMenu).TopMenuItem - 1
  403.  
  404. End Function
  405.  
  406. Private Function GetSpace() As Single
  407.  
  408.    If m_ItemIconSize = 16 Then
  409.       GetSpace = 1.5
  410.       
  411.    Else
  412.       GetSpace = 1
  413.    End If
  414.  
  415. End Function
  416.  
  417. Private Function IsMenuButtonHitOrClicked(ByVal MousePosition As Long, ByVal X As Long, ByVal Y As Long) As Integer
  418.  
  419. Static intPrevMenu As Integer
  420.  
  421. Dim clsMenus       As clsMenu
  422. Dim clsPrevMenu    As clsMenu
  423.  
  424.    If m_ButtonHideInSingleMenu Then Exit Function
  425.    
  426.    For Each clsMenus In m_Menus
  427.       picMenu.ToolTipText = ""
  428.       
  429.       With clsMenus
  430.          If intPrevMenu And (intPrevMenu <> .Index) And (MousePosition <> MOUSE_CHECK) Then
  431.             Call .DrawBorder(RAISED)
  432.             
  433.             intPrevMenu = 0
  434.          End If
  435.          
  436.          If .IsMenuSelected(X, Y) Then
  437.             If MousePosition <> MOUSE_CHECK Then
  438.                If Not clsPrevMenu Is Nothing Then If Y >= picMenu.ScaleHeight \ 2 Then clsPrevMenu.ClearItemHit MousePosition, X, Y
  439.                
  440.                .HitTest MousePosition, X, Y
  441.                picMenu.ToolTipText = .ToolTipText
  442.             End If
  443.             
  444.             IsMenuButtonHitOrClicked = .Index
  445.             intPrevMenu = .Index
  446.             Exit For
  447.          End If
  448.       End With
  449.       
  450.       Set clsPrevMenu = clsMenus
  451.    Next 'clsMenus
  452.    
  453.    Set clsMenus = Nothing
  454.    Set clsPrevMenu = Nothing
  455.  
  456. End Function
  457.  
  458. Private Sub DrawItemIcon()
  459.  
  460.    m_ItemsShowed = m_Menus.Item(m_CurrentMenu).PaintItems(FirstIcon, m_CurrentMenu, ClipHeight, m_Menus.Count, m_ItemIconSize, m_ItemAlignment, m_OnlyFullItemsShow, m_OnlyFullItemsHit, ButtonHideInSingleMenu)
  461.  
  462. End Sub
  463.  
  464. Private Sub PaintButton(ByVal CurrentMenu As Integer, ByVal Y As Long, ByVal Width As Long, ByVal IconSize As Integer, ByVal ButtonHeight As Long, ByRef IconTop As Long)
  465.  
  466. Dim lngX       As Long
  467. Dim strCaption As String
  468.  
  469.    If m_ButtonHideInSingleMenu Then Exit Sub
  470.    
  471.    With m_Menus.Item(CurrentMenu)
  472.       If Not .Icon Is Nothing Then
  473.          DrawIconEx picMenu.hDC, 4 + ((Width - IconSize - 8) And (m_IconAlignment = [Right Justify])), IconTop, .Icon.Handle, IconSize, IconSize, 0, 0, DI_NORMAL
  474.          lngX = (16 And (m_ButtonHeight = MENU_BUTTON_MIN_HEIGHT))
  475.          
  476.          If m_IconAlignment = [Left Justify] Then
  477.             If m_CaptionAlignment = vbLeftJustify Then lngX = 34 - lngX
  478.             
  479.          ElseIf m_CaptionAlignment = vbRightJustify Then
  480.             lngX = -34 + lngX
  481.          End If
  482.       End If
  483.    End With
  484.    
  485.    With picMenu
  486.       strCaption = m_Menus.Item(CurrentMenu).Caption
  487.       .CurrentX = lngX + AlignCaption(.TextWidth(strCaption), .Width)
  488.       .CurrentY = Y + (m_ButtonHeight - .TextHeight("X")) \ 2
  489.       picMenu.Print strCaption
  490.       IconTop = IconTop + ButtonHeight
  491.    End With
  492.  
  493. End Sub
  494.  
  495. Private Sub RePaint()
  496.  
  497. Dim intIconSize As Integer
  498. Dim intMenu     As Integer
  499. Dim lngIconTop  As Long
  500. Dim lngMax      As Long
  501. Dim lngSrcDC    As Long
  502.  
  503.    lngMax = m_Menus.Count
  504.    
  505.    With picMenu
  506.       If m_NumberOfMenusChanged Then
  507.          m_NumberOfMenusChanged = False
  508.          .Cls
  509.       End If
  510.       
  511.       lngSrcDC = picCache.hDC
  512.       
  513.       If (lngMax = 0) Or (.hDC = 0) Or (lngSrcDC = 0) Then Exit Sub
  514.       
  515.       .ForeColor = m_ForeColor
  516.       .FontBold = m_FontBoldButtonCaption
  517.       intIconSize = 32 - (16 And (m_ButtonHeight = MENU_BUTTON_MIN_HEIGHT))
  518.       lngIconTop = 3
  519.       
  520.       For intMenu = 1 To m_CurrentMenu
  521.          BitBlt .hDC, 0, (intMenu - 1) * m_ButtonHeight, .ScaleWidth, m_ButtonHeight, lngSrcDC, 0, 0, vbSrcCopy
  522.          
  523.          Call PaintButton(intMenu, CLng(intMenu - 1) * m_ButtonHeight, .ScaleWidth, intIconSize, m_ButtonHeight, lngIconTop)
  524.       Next 'intMenu
  525.       
  526.       lngIconTop = .ScaleHeight - m_ButtonHeight + 3
  527.       
  528.       For intMenu = lngMax To m_CurrentMenu + 1 Step -1
  529.          BitBlt .hDC, 0, .ScaleHeight - (lngMax - intMenu + 1) * m_ButtonHeight, .ScaleWidth, m_ButtonHeight, lngSrcDC, 0, 0, vbSrcCopy
  530.          
  531.          Call PaintButton(intMenu, CLng(.ScaleHeight - (lngMax - intMenu + 1) * m_ButtonHeight), .ScaleWidth, intIconSize, -m_ButtonHeight, lngIconTop)
  532.       Next 'intMenu
  533.       
  534.       .FontBold = m_FontBoldItemCaption
  535.    End With
  536.  
  537. End Sub
  538.  
  539. Private Sub ReSelectDown()
  540.  
  541. Dim blnFirst      As Boolean
  542. Dim intMaxMenus   As Integer
  543. Dim lngHeight     As Long
  544. Dim lngMenuTop    As Long
  545. Dim lngPixelCount As Long
  546. Dim lngSrcDC      As Long
  547. Dim lngStartY     As Long
  548. Dim lngStopY      As Long
  549.  
  550.    intMaxMenus = m_Menus.Count
  551.    
  552.    With picMenu
  553.       blnFirst = True
  554.       lngSrcDC = picCache.hDC
  555.       lngStartY = .ScaleHeight - (intMaxMenus - m_CurrentMenu) * m_ButtonHeight
  556.       lngStopY = PreviousMenu * m_ButtonHeight
  557.       lngMenuTop = .ScaleHeight - (intMaxMenus - PreviousMenu) * m_ButtonHeight
  558.       
  559.       If (intMaxMenus = 0) Or (.hDC = 0) Or (lngSrcDC = 0) Then Exit Sub
  560.       
  561.       If m_Animation Then
  562.          Do
  563.             BitBlt .hDC, 0, lngStopY, .ScaleWidth, lngStartY - lngStopY - lngPixelCount - PIXELS_PER_BITBLT - ((Not (blnFirst)) * PIXELS_PER_BITBLT), .hDC, 0, lngStopY + PIXELS_PER_BITBLT, vbSrcCopy
  564.             
  565.             If blnFirst Then
  566.                BitBlt .hDC, 0, lngStartY - PIXELS_PER_BITBLT, .ScaleWidth, PIXELS_PER_BITBLT, lngSrcDC, 0, m_ButtonHeight + 3, vbSrcCopy
  567.                blnFirst = False
  568.             End If
  569.             
  570.             lngPixelCount = lngPixelCount + PIXELS_PER_BITBLT
  571.          Loop Until lngMenuTop - ((lngPixelCount + 1) * PIXELS_PER_BITBLT) <= lngStopY
  572.          
  573.          BitBlt .hDC, 0, lngStopY, .ScaleWidth, lngStartY - lngStopY - 1 - lngPixelCount - (Not (blnFirst) * PIXELS_PER_BITBLT), .hDC, 0, lngMenuTop - lngPixelCount, vbSrcCopy
  574.          
  575.       Else
  576.          lngHeight = (m_CurrentMenu - PreviousMenu) * m_ButtonHeight
  577.          BitBlt .hDC, 0, lngStopY, .ScaleWidth, lngHeight, .hDC, 0, lngMenuTop, vbSrcCopy
  578.          StretchBlt .hDC, 0, lngStopY + lngHeight, .ScaleWidth, lngStartY - lngStopY - lngHeight, .hDC, 0, lngMenuTop - 1, 1, 1, vbSrcCopy
  579.       End If
  580.    End With
  581.  
  582. End Sub
  583.  
  584. Private Sub ReSelectUp()
  585.  
  586. Dim blnFirst      As Boolean
  587. Dim intMaxMenus   As Integer
  588. Dim lngMenuBottom As Long
  589. Dim lngPixelCount As Long
  590. Dim lngHeight     As Long
  591. Dim lngSrcDC      As Long
  592. Dim lngStartY     As Long
  593. Dim lngStopY      As Long
  594.  
  595.    intMaxMenus = m_Menus.Count
  596.    
  597.    With picMenu
  598.       blnFirst = True
  599.       lngSrcDC = picCache.hDC
  600.       lngStartY = m_CurrentMenu * m_ButtonHeight
  601.       lngStopY = .ScaleHeight - (intMaxMenus - PreviousMenu) * m_ButtonHeight
  602.       lngMenuBottom = PreviousMenu * m_ButtonHeight
  603.       
  604.       If (intMaxMenus = 0) Or (.hDC = 0) Or (lngSrcDC = 0) Then Exit Sub
  605.       
  606.       If m_Animation Then
  607.          Do
  608.             BitBlt .hDC, 0, lngStartY + lngPixelCount + PIXELS_PER_BITBLT + ((Not (blnFirst)) * PIXELS_PER_BITBLT), .ScaleWidth, lngStopY - lngStartY - lngPixelCount - PIXELS_PER_BITBLT - ((Not (blnFirst)) * PIXELS_PER_BITBLT), .hDC, 0, lngStartY + lngPixelCount + ((Not (blnFirst)) * PIXELS_PER_BITBLT), vbSrcCopy
  609.             
  610.             If blnFirst Then
  611.                BitBlt .hDC, 0, lngStartY + (lngPixelCount * PIXELS_PER_BITBLT), .ScaleWidth, PIXELS_PER_BITBLT, lngSrcDC, 0, m_ButtonHeight + 3, vbSrcCopy
  612.                blnFirst = False
  613.             End If
  614.             
  615.             lngPixelCount = lngPixelCount + PIXELS_PER_BITBLT
  616.          Loop Until lngMenuBottom + lngPixelCount >= lngStopY
  617.          
  618.          BitBlt .hDC, 0, lngStopY - (PreviousMenu - m_CurrentMenu) * m_ButtonHeight - PIXELS_PER_BITBLT, .ScaleWidth, (PreviousMenu - m_CurrentMenu) * m_ButtonHeight + PIXELS_PER_BITBLT, .hDC, 0, lngStartY + lngPixelCount - PIXELS_PER_BITBLT, vbSrcCopy
  619.          
  620.       Else
  621.          lngHeight = (m_CurrentMenu - PreviousMenu) * m_ButtonHeight
  622.          BitBlt .hDC, 0, lngStopY, .ScaleWidth, lngHeight, .hDC, 0, lngMenuBottom, vbSrcCopy
  623.          StretchBlt .hDC, 0, lngStartY, .ScaleWidth, lngStopY - lngStartY + lngHeight, .hDC, 0, lngMenuBottom + 1, 1, 1, vbSrcCopy
  624.       End If
  625.    End With
  626.  
  627. End Sub
  628.  
  629. Private Sub ScrollDown()
  630.  
  631. Dim intMaxMenus   As Integer
  632. Dim lngStartY     As Long
  633. Dim lngStopY      As Long
  634. Dim lngPixelCount As Long
  635. Dim lngSrcDC      As Long
  636. Dim lngPixel      As Long
  637.  
  638.    With m_Menus.Item(m_CurrentMenu)
  639.       .TopMenuItem = .TopMenuItem + 1
  640.       .HideButton ARROW_BUTTON_DOWN, m_Menus.Count - m_CurrentMenu
  641.    End With
  642.    
  643.    intMaxMenus = m_Menus.Count
  644.    
  645.    With picMenu
  646.       lngSrcDC = picCache.hDC
  647.       lngStartY = .ScaleHeight - (intMaxMenus - m_CurrentMenu) * m_ButtonHeight
  648.       lngStopY = m_CurrentMenu * m_ButtonHeight
  649.       
  650.       If (intMaxMenus = 0) Or (.hDC = 0) Or (lngSrcDC = 0) Then Exit Sub
  651.       
  652.       If m_Animation Then
  653.          For lngPixel = 1 To m_ItemIconSize * 2 * GetSpace
  654.             ' move the screen up
  655.             BitBlt .hDC, 0, lngStopY, .ScaleWidth, lngStartY - lngStopY, .hDC, 0, lngStopY + PIXELS_PER_BITBLT, vbSrcCopy
  656.             ' repaint the background
  657.             BitBlt .hDC, 0, lngStartY - 1, .ScaleWidth, PIXELS_PER_BITBLT, lngSrcDC, 0, m_ButtonHeight + 3, vbSrcCopy
  658.             lngPixelCount = lngPixelCount + PIXELS_PER_BITBLT
  659.          Next 'lngPixel
  660.       End If
  661.       
  662.       StretchBlt .hDC, 0, lngStopY, .ScaleWidth, lngStartY - lngStopY, .hDC, 0, lngStartY - 1, 1, 1, vbSrcCopy
  663.    End With
  664.    
  665.    Call DrawItemIcon
  666.    Call SetButtonsHotSpot
  667.  
  668. End Sub
  669.  
  670. Private Sub ScrollUp()
  671.  
  672. Dim intMaxMenus   As Integer
  673. Dim lngStartY     As Long
  674. Dim lngStopY      As Long
  675. Dim lngPixelCount As Long
  676. Dim lngSrcDC      As Long
  677. Dim lngPixel      As Long
  678.  
  679.    With m_Menus.Item(m_CurrentMenu)
  680.       .TopMenuItem = .TopMenuItem - 1
  681.       .HideButton ARROW_BUTTON_UP, m_CurrentMenu
  682.    End With
  683.    
  684.    intMaxMenus = m_Menus.Count
  685.    
  686.    With picMenu
  687.       lngSrcDC = picCache.hDC
  688.       lngStartY = m_CurrentMenu * m_ButtonHeight
  689.       lngStopY = .ScaleHeight - (intMaxMenus - m_CurrentMenu) * m_ButtonHeight
  690.       
  691.       If (intMaxMenus = 0) Or (.hDC = 0) Or (lngSrcDC = 0) Then Exit Sub
  692.       
  693.       If m_Animation Then
  694.          For lngPixel = 1 To m_ItemIconSize * 2 * GetSpace
  695.             ' move the screen up
  696.             BitBlt .hDC, 0, lngStartY + PIXELS_PER_BITBLT, .ScaleWidth, lngStopY - lngStartY - 1, .hDC, 0, lngStartY, vbSrcCopy
  697.             ' repaint the background
  698.             BitBlt .hDC, 0, lngStartY, .ScaleWidth, PIXELS_PER_BITBLT, lngSrcDC, 0, m_ButtonHeight + 3, vbSrcCopy
  699.             lngPixelCount = lngPixelCount + PIXELS_PER_BITBLT
  700.          Next 'lngPixel
  701.       End If
  702.       
  703.       StretchBlt .hDC, 0, lngStopY, .ScaleWidth, lngStartY - lngStopY, .hDC, 0, lngStartY, 1, 1, vbSrcCopy
  704.    End With
  705.    
  706.    Call DrawItemIcon
  707.    Call SetButtonsHotSpot
  708.  
  709. End Sub
  710.  
  711. Private Sub SetButtonsHotSpot()
  712.  
  713. Dim clsMenus As clsMenu
  714. Dim intMax   As Integer
  715.  
  716.    intMax = m_Menus.Count
  717.    
  718.    For Each clsMenus In m_Menus
  719.       With clsMenus
  720.          If .Index <= m_CurrentMenu Then
  721.             .ButtonTop = (.Index - 1) * m_ButtonHeight
  722.             
  723.          Else
  724.             .ButtonTop = picMenu.ScaleHeight - (intMax - .Index + 1) * m_ButtonHeight
  725.          End If
  726.       End With
  727.    Next 'clsMenus
  728.    
  729.    Set clsMenus = Nothing
  730.  
  731. End Sub
  732.  
  733. Private Sub Class_Initialize()
  734.  
  735.    Set m_Menus = New Collection
  736.  
  737. End Sub
  738.  
  739. Private Sub Class_Terminate()
  740.  
  741.    Set m_Menus = Nothing
  742.    Set picCache = Nothing
  743.    Set picMenu = Nothing
  744.  
  745. End Sub
  746.