home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / VertMenu.exe / Menus.cls < prev    next >
Encoding:
Visual Basic class definition  |  1997-03-26  |  21.9 KB  |  709 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Menus"
  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. Private picMenu As PictureBox
  13. Private picCache As PictureBox
  14. Private colMenus As New Collection
  15. Private mlButtonHeight As Long
  16. Private mlMenuPrev As Long
  17. Private mlMenuCur As Long
  18. Private mbNumberOfMenusChanged As Boolean
  19.  
  20. #If USE_WING Then
  21.     Private Declare Function WinGBitBlt Lib "wing32.dll" (ByVal hDestDC 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) As Long
  22. #Else
  23.     Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
  24. #End If
  25.  
  26. Const SRCCOPY = &HCC0020
  27. Const PIXELS_PER_BITBLT = 1
  28. Const TYPE_UP = 1
  29. Const TYPE_DOWN = -1
  30.  
  31. ' add a new Menu to the collection
  32. ' Parameters:   sCaption    Caption of the Menu
  33. '               lIndex      Location of the Menu in Menus collection
  34. Public Function Add(ByVal sCaption As String, lIndex As Long, ByVal picMenu As Object) As VMenu
  35.     Dim newMenu As New VMenu
  36.     
  37.     On Error Resume Next
  38.     
  39.     With newMenu
  40.         .Caption = sCaption
  41.         .Index = lIndex
  42.         Set .Control = picMenu
  43.         .ButtonHeight = mlButtonHeight
  44.     End With
  45.         ' add the item to the collection specified by lIndex
  46.         ' note, if there is nothing in the collection, just add it
  47.         ' if there is nothing in the collection or we are adding it at then end, just add it
  48.         ' elseif we are inserting in the first position, add it BEFORE
  49.         ' else add it AFTER the previous item
  50.         If colMenus.Count = 0 Then
  51.             colMenus.Add newMenu
  52.         ElseIf lIndex = colMenus.Count + 1 Then
  53.             colMenus.Add newMenu
  54.         ElseIf lIndex = 1 Then
  55.             colMenus.Add newMenu, , 1
  56.         Else
  57.             colMenus.Add newMenu, , , lIndex - 1
  58.         End If
  59.     
  60.     Set Add = newMenu
  61. End Function
  62.  
  63. ' delete the Menu from the collection
  64. ' Parameters:       lIndex  Index of the collection member
  65. Public Sub Delete(lIndex As Long)
  66.     On Error Resume Next
  67.     colMenus.Remove lIndex
  68. End Sub
  69.  
  70. ' return the object of the Menu in the collection
  71. ' Parameters:       lIndex  Index of the collection member
  72. Public Property Get Item(lIndex As Variant) As VMenu
  73.     On Error Resume Next
  74.     If lIndex > 0 Then
  75.         Set Item = colMenus(lIndex)
  76.     End If
  77. End Property
  78.  
  79. ' return the number of Menus in the collection
  80. Public Function Count() As Long
  81.     On Error Resume Next
  82.     Count = colMenus.Count
  83. End Function
  84.  
  85. ' move a Menu to a new location
  86. ' Parameters:       lCurIndex   the current location
  87. '                   lNewIndex   the new location
  88. Public Sub MoveMenu(lCurIndex As Long, lNewIndex As Long)
  89.     ' under construction
  90. End Sub
  91.  
  92. ' move a MenuItem to a new location
  93. ' Parameters:       lCurIndex   the current location
  94. '                   lNewIndex   the new location
  95. Public Sub MoveMenuItem(lCurIndex As Long, lNewIndex As Long)
  96.     ' undex construction
  97. End Sub
  98.  
  99. Public Property Get Caption(lIndex As Long) As String
  100.     On Error Resume Next
  101.     Caption = colMenus(lIndex).Caption
  102. End Property
  103.  
  104. Public Property Let Caption(lIndex As Long, sNewValue As String)
  105.     On Error Resume Next
  106.     colMenus(lIndex).Caption = sNewValue
  107. End Property
  108.  
  109. Public Property Get ButtonHeight() As Long
  110.     On Error Resume Next
  111.     ButtonHeight = mlButtonHeight
  112. End Property
  113.  
  114. Public Property Let ButtonHeight(ByVal lNewValue As Long)
  115.     On Error Resume Next
  116.     mlButtonHeight = lNewValue
  117. End Property
  118.  
  119. Public Property Set Menu(oNewValue As PictureBox)
  120.     On Error Resume Next
  121.     Set picMenu = oNewValue
  122. End Property
  123.  
  124. Public Property Set Cache(oNewValue As PictureBox)
  125.     On Error Resume Next
  126.     Set picCache = oNewValue
  127. End Property
  128.  
  129. Public Property Let MenuCur(lNewValue As Long)
  130.     On Error Resume Next
  131.     mlMenuCur = lNewValue
  132. End Property
  133.  
  134. ' Procedure: Paint
  135. ' This is the main procedure that paints our control
  136. ' It handles repaints as well as well as changes of the
  137. ' current menu
  138. ' Since we can move several menus at once, the code for
  139. ' this is done here in the collection of menus rather then
  140. ' the the menu class itself.  However, the painting of the
  141. ' MenuItems is done in the MenuItem class itself.
  142. Public Sub Paint()
  143.     On Error Resume Next
  144.     If mlMenuPrev = 0 Then               ' first time paint
  145.         mlMenuPrev = mlMenuCur
  146.     End If
  147.  
  148.     If mlMenuPrev = mlMenuCur Then
  149.         Repaint
  150.     ElseIf mlMenuPrev < mlMenuCur Then    ' user selected a menu after the previously selected menu
  151.         ReselectDown
  152.     Else                                ' user selected a menu before the previously selected menu
  153.         ReselectUp
  154.     End If
  155.     
  156.     DrawIcons
  157.     
  158.     SetMenuButtonsHotSpot
  159.     
  160.     mlMenuPrev = mlMenuCur                ' save this menu as the next previous menu
  161. End Sub
  162.  
  163. ' repaint the menu as is - no changes were made
  164. ' support subroutine for Paint
  165. Private Sub Repaint()
  166.     Dim l As Long
  167.     Dim lMax As Long
  168.     Dim lResult As Long
  169.     Dim hDestDC As Long
  170.     Dim hSrcDC As Long
  171.     Dim sCaption As String
  172.     Dim lWidth As Long
  173.     Dim lHeight As Long
  174.     On Error Resume Next
  175.     
  176.     ' setup variables
  177.     lMax = colMenus.Count
  178.     With picMenu
  179.         ' if we just changed the number of menus then
  180.         ' we need to clear the control first
  181.         If mbNumberOfMenusChanged Then
  182.             .Cls
  183.             mbNumberOfMenusChanged = False
  184.         End If
  185.         hDestDC = .hdc
  186.         .ScaleMode = vbPixels
  187.         .ForeColor = vbButtonText
  188.         lWidth = CLng(.ScaleWidth)
  189.         lHeight = CLng(.ScaleHeight)
  190.     End With
  191.     hSrcDC = picCache.hdc
  192.     
  193.     If lMax = 0 Or hDestDC = 0 Or hSrcDC = 0 Then
  194.         Exit Sub
  195.     End If
  196.     
  197.     ' first, paint the menus up to the currently select one
  198.     For l = 1 To mlMenuCur
  199.         With picMenu
  200.             ' draw the button
  201. #If USE_WING Then
  202.             lResult = WinGBitBlt(hDestDC, 0, _
  203.                 (l - 1) * mlButtonHeight, _
  204.                 lWidth, _
  205.                 mlButtonHeight, _
  206.                 hSrcDC, 0, 0)
  207. #Else
  208.             lResult = BitBlt(hDestDC, 0, _
  209.                 (l - 1) * mlButtonHeight, _
  210.                 lWidth, _
  211.                 mlButtonHeight, _
  212.                 hSrcDC, 0, 0, SRCCOPY)
  213. #End If
  214.             ' print the caption
  215.             sCaption = colMenus.Item(l).Caption
  216.             .CurrentX = (lWidth \ 2) - (.TextWidth(sCaption) \ 2)
  217.             .CurrentY = (l - 1) * mlButtonHeight + 2
  218.             picMenu.Print sCaption
  219.         End With
  220.     Next
  221.     
  222.     ' now, paint the menus below the currently seleted one (from the bottom up)
  223.     For l = lMax To mlMenuCur + 1 Step -1
  224.         With picMenu
  225.             ' draw the button
  226. #If USE_WING Then
  227.             lResult = WinGBitBlt(hDestDC, 0, _
  228.                 lHeight - (lMax - l + 1) * mlButtonHeight, _
  229.                 lWidth, _
  230.                 mlButtonHeight, _
  231.                 hSrcDC, 0, 0)
  232. #Else
  233.             lResult = BitBlt(hDestDC, 0, _
  234.                 lHeight - (lMax - l + 1) * mlButtonHeight, _
  235.                 lWidth, _
  236.                 mlButtonHeight, _
  237.                 hSrcDC, 0, 0, SRCCOPY)
  238. #End If
  239.             ' print the caption
  240.             sCaption = colMenus.Item(l).Caption
  241.             .CurrentX = (lWidth \ 2) - (.TextWidth(sCaption) \ 2)
  242.             .CurrentY = lHeight - (lMax - l + 1) * mlButtonHeight + 2
  243.             picMenu.Print sCaption
  244.         End With
  245.     Next
  246.     
  247. End Sub
  248.  
  249. ' the new current menu is further down on the menu than the previous one
  250. ' we need to move the menus up from the previous menu + 1 to the new current menu
  251. ' support subroutine for Paint
  252. Private Sub ReselectDown()
  253.     Dim lStartY As Long
  254.     Dim lStopY As Long
  255.     Dim lTopOfGroupY As Long
  256.     Dim lPixelCount As Long
  257.     Dim lResult As Long
  258.     Dim lMax As Long
  259.     Dim hDestDC As Long
  260.     Dim hSrcDC As Long
  261.     Dim lWidth As Long
  262.     Dim bFirst As Boolean
  263.     
  264.     On Error Resume Next
  265.  
  266.     ' setup variables
  267.     bFirst = True
  268.     lMax = colMenus.Count
  269.     With picMenu
  270.         hDestDC = .hdc
  271.         .ScaleMode = vbPixels
  272.         .ForeColor = vbButtonText
  273.         lWidth = .ScaleWidth
  274.         lStopY = mlMenuPrev * mlButtonHeight
  275.         lStartY = .ScaleHeight - (lMax - mlMenuCur) * mlButtonHeight
  276.         lTopOfGroupY = .ScaleHeight - (lMax - mlMenuPrev) * mlButtonHeight
  277.     End With
  278.     hSrcDC = picCache.hdc
  279.     
  280.     If lMax = 0 Or hDestDC = 0 Or hSrcDC = 0 Then
  281.         Exit Sub
  282.     End If
  283.     
  284.     Do
  285. #If USE_WING Then
  286.         lResult = WinGBitBlt(hDestDC, 0, _
  287.             lStopY, _
  288.             lWidth, _
  289.             lStartY - lStopY - lPixelCount - PIXELS_PER_BITBLT - ((Not (bFirst)) * PIXELS_PER_BITBLT), _
  290.             hDestDC, 0, lStopY + PIXELS_PER_BITBLT)
  291. #Else
  292.         lResult = BitBlt(hDestDC, 0, _
  293.             lStopY, _
  294.             lWidth, _
  295.             lStartY - lStopY - lPixelCount - PIXELS_PER_BITBLT - ((Not (bFirst)) * PIXELS_PER_BITBLT), _
  296.             hDestDC, 0, lStopY + PIXELS_PER_BITBLT, SRCCOPY)
  297. #End If
  298.         If bFirst Then
  299. #If USE_WING Then
  300.             lResult = WinGBitBlt(hDestDC, 0, _
  301.                 lStartY - PIXELS_PER_BITBLT, _
  302.                 lWidth, _
  303.                 PIXELS_PER_BITBLT, _
  304.                 hSrcDC, 0, mlButtonHeight + 3)
  305. #Else
  306.             lResult = BitBlt(hDestDC, 0, _
  307.                 lStartY - PIXELS_PER_BITBLT, _
  308.                 lWidth, _
  309.                 PIXELS_PER_BITBLT, _
  310.                 hSrcDC, 0, mlButtonHeight + 3, SRCCOPY)
  311.             bFirst = False
  312. #End If
  313.         End If
  314.         
  315.         lPixelCount = lPixelCount + PIXELS_PER_BITBLT
  316.     
  317.     Loop Until lTopOfGroupY - ((lPixelCount + 1) * PIXELS_PER_BITBLT) <= lStopY
  318.  
  319.     ' make sure the group is in it's correct final position
  320. #If USE_WING Then
  321.     lResult = WinGBitBlt(hDestDC, 0, _
  322.         lStopY, _
  323.         lWidth, _
  324.         lStartY - lStopY - 1 - lPixelCount - (Not (bFirst) * PIXELS_PER_BITBLT), _
  325.         hDestDC, 0, lTopOfGroupY - lPixelCount)
  326. #Else
  327.     lResult = BitBlt(hDestDC, 0, _
  328.         lStopY, _
  329.         lWidth, _
  330.         lStartY - lStopY - 1 - lPixelCount - (Not (bFirst) * PIXELS_PER_BITBLT), _
  331.         hDestDC, 0, lTopOfGroupY - lPixelCount, SRCCOPY)
  332. #End If
  333. End Sub
  334.  
  335. ' the new current menu is further up on the menu than the previous one
  336. ' we need to move the menus down from the current menu + 1 to the previous menu
  337. ' support subroutine for Paint
  338. Private Sub ReselectUp()
  339.     Dim lStartY As Long
  340.     Dim lStopY As Long
  341.     Dim lBottomOfGroupY As Long
  342.     Dim lPixelCount As Long
  343.     Dim lResult As Long
  344.     Dim lMax As Long
  345.     Dim hDestDC As Long
  346.     Dim hSrcDC As Long
  347.     Dim lWidth As Long
  348.     Dim bFirst As Boolean
  349.     
  350.     On Error Resume Next
  351.  
  352.     ' setup variables
  353.     bFirst = True
  354.     lMax = colMenus.Count
  355.     With picMenu
  356.         hDestDC = .hdc
  357.         .ScaleMode = vbPixels
  358.         .ForeColor = vbButtonText
  359.         lWidth = .ScaleWidth
  360.         lStartY = (mlMenuCur) * mlButtonHeight
  361.         lStopY = .ScaleHeight - (lMax - mlMenuPrev) * mlButtonHeight
  362.         lBottomOfGroupY = mlMenuPrev * mlButtonHeight
  363.     End With
  364.     hSrcDC = picCache.hdc
  365.     
  366.     If lMax = 0 Or hDestDC = 0 Or hSrcDC = 0 Then
  367.         Exit Sub
  368.     End If
  369.     
  370.     Do
  371. #If USE_WING Then
  372.         lResult = WinGBitBlt(hDestDC, 0, _
  373.             lStartY + lPixelCount + PIXELS_PER_BITBLT + ((Not (bFirst)) * PIXELS_PER_BITBLT), _
  374.             lWidth, _
  375.             lStopY - lStartY - lPixelCount - PIXELS_PER_BITBLT - ((Not (bFirst)) * PIXELS_PER_BITBLT), _
  376.             hDestDC, 0, lStartY + lPixelCount + ((Not (bFirst)) * PIXELS_PER_BITBLT))
  377. #Else
  378.         lResult = BitBlt(hDestDC, 0, _
  379.             lStartY + lPixelCount + PIXELS_PER_BITBLT + ((Not (bFirst)) * PIXELS_PER_BITBLT), _
  380.             lWidth, _
  381.             lStopY - lStartY - lPixelCount - PIXELS_PER_BITBLT - ((Not (bFirst)) * PIXELS_PER_BITBLT), _
  382.             hDestDC, 0, lStartY + lPixelCount + ((Not (bFirst)) * PIXELS_PER_BITBLT), SRCCOPY)
  383. #End If
  384.         
  385.         If bFirst Then
  386. #If USE_WING Then
  387.             lResult = WinGBitBlt(hDestDC, 0, _
  388.                 lStartY + (lPixelCount * PIXELS_PER_BITBLT), _
  389.                 lWidth, _
  390.                 PIXELS_PER_BITBLT, _
  391.                 hSrcDC, 0, mlButtonHeight + 3)
  392. #Else
  393.             lResult = BitBlt(hDestDC, 0, _
  394.                 lStartY + (lPixelCount * PIXELS_PER_BITBLT), _
  395.                 lWidth, _
  396.                 PIXELS_PER_BITBLT, _
  397.                 hSrcDC, 0, mlButtonHeight + 3, SRCCOPY)
  398. #End If
  399.             bFirst = False
  400.         End If
  401.         
  402.         lPixelCount = lPixelCount + PIXELS_PER_BITBLT
  403.     Loop Until lBottomOfGroupY + lPixelCount >= lStopY
  404.     
  405.     ' make sure the group is in it's correct final position
  406. #If USE_WING Then
  407.     lResult = WinGBitBlt(hDestDC, 0, _
  408.         lStopY - (mlMenuPrev - mlMenuCur) * mlButtonHeight - PIXELS_PER_BITBLT, _
  409.         lWidth, _
  410.         (mlMenuPrev - mlMenuCur) * mlButtonHeight + PIXELS_PER_BITBLT, _
  411.         hDestDC, 0, lStartY + lPixelCount - PIXELS_PER_BITBLT)
  412. #Else
  413.     lResult = BitBlt(hDestDC, 0, _
  414.         lStopY - (mlMenuPrev - mlMenuCur) * mlButtonHeight - PIXELS_PER_BITBLT, _
  415.         lWidth, _
  416.         (mlMenuPrev - mlMenuCur) * mlButtonHeight + PIXELS_PER_BITBLT, _
  417.         hDestDC, 0, lStartY + lPixelCount - PIXELS_PER_BITBLT, SRCCOPY)
  418. #End If
  419. End Sub
  420.  
  421. ' draw the icons for the currently select menu
  422. ' support subroutine for Paint
  423. Private Sub DrawIcons()
  424.     On Error Resume Next
  425.     colMenus.Item(mlMenuCur).PaintItems IconStart(), mlMenuCur, ClipY(), colMenus.Count
  426. End Sub
  427.  
  428. ' support subroutine for Paint
  429. Private Sub SetMenuButtonsHotSpot()
  430.     Dim lIndex As Long
  431.     Dim lMax As Long
  432.     Dim VMenu As VMenu
  433.     
  434.     On Error Resume Next
  435.     lMax = colMenus.Count
  436.     For Each VMenu In colMenus
  437.         With VMenu
  438.             lIndex = .Index
  439.             If lIndex <= mlMenuCur Then      ' the menu is at the top of the control
  440.                 .ButtonTop = (lIndex - 1) * mlButtonHeight
  441.             Else                            ' the menu is at the bottom of the control
  442.                 .ButtonTop = picMenu.ScaleHeight - (lMax - lIndex + 1) * mlButtonHeight
  443.             End If
  444.         End With
  445.     Next
  446. End Sub
  447.  
  448. ' determines if the mouse was clicked in a menu button
  449. ' returns the index of the menu clicked
  450. ' if no menu clicked, returns 0
  451. Public Function IsMenuButtonClicked(ByVal ptX As Long, ByVal ptY As Long) As Long
  452.     Dim VMenu As VMenu
  453.     
  454.     On Error Resume Next
  455.     For Each VMenu In colMenus
  456.         With VMenu
  457.             If .IsMenuSelected(ptX, ptY) Then
  458.                 IsMenuButtonClicked = .Index
  459.                 Exit Function
  460.             End If
  461.         End With
  462.     Next
  463. End Function
  464.  
  465. Public Property Let NumberOfMenusChanged(ByVal bNewValue As Boolean)
  466.     On Error Resume Next
  467.     mbNumberOfMenusChanged = bNewValue
  468. End Property
  469.  
  470. Public Property Get TotalMenuItems() As Long
  471.     Dim VMenu As VMenu
  472.     Dim lTotal As Long
  473.     
  474.     On Error Resume Next
  475.     For Each VMenu In colMenus
  476.         lTotal = lTotal + VMenu.MenuItemCount
  477.     Next
  478.     TotalMenuItems = lTotal
  479. End Property
  480.  
  481. ' Process mouse events
  482. ' Note that even if we get a hit, we must process all code
  483. ' The individual objects handle their own paints depending what
  484. ' the mouse is doing.
  485. Public Function MouseProcess(ByVal iMousePosition As Integer, ByVal X As Long, ByVal Y As Long, Optional lHitType As Long) As Long
  486.     Dim lResult As Long
  487.     Dim MenuItems As MenuItems
  488.     Const HIT_TYPE_MENU_BUTTON = 1
  489.     Const HIT_TYPE_MENUITEM = 2
  490.     Const HIT_TYPE_UP_ARROW = 3
  491.     Const HIT_TYPE_DOWN_ARROW = 4
  492.     Const SCROLL_UP = 100
  493.     Const SCROLL_DOWN = -100
  494.     Const MOUSE_UP = 1
  495.     Const MOUSE_DOWN = -1
  496.     Const MOUSE_MOVE = 0
  497.     
  498.     ' first test for a MenuButtonHit
  499.     If iMousePosition = MOUSE_DOWN Then
  500.         lResult = IsMenuButtonClicked(X, Y)
  501.         'if lResult is non-zero we have a hit
  502.         ' so tell the calling procedure and return
  503.         If lResult <> 0 Then
  504.             lHitType = HIT_TYPE_MENU_BUTTON
  505.             MouseProcess = lResult
  506.         End If
  507.     End If
  508.     
  509.     ' test for a MenuItemHit
  510.     ' don't do the test if we got a MenuButtonHit
  511.     If lResult = 0 Then
  512.         Set MenuItems = colMenus.Item(mlMenuCur).MenuItems()
  513.         lResult = MenuItems.MouseProcess(iMousePosition, X, Y)
  514.         If iMousePosition = MOUSE_UP And lResult > 0 Then
  515.             lHitType = HIT_TYPE_MENUITEM
  516.             MouseProcess = lResult
  517.         End If
  518.     End If
  519.     
  520.     ' test for arrow buttons
  521.     lResult = colMenus.Item(mlMenuCur).MouseProcessForArrows(iMousePosition, X, Y)
  522.     If lResult <> 0 Then
  523.         Select Case lResult
  524.             Case SCROLL_UP
  525.                 ScrollUp
  526.                 lHitType = HIT_TYPE_UP_ARROW
  527.             Case SCROLL_DOWN
  528.                 ScrollDown
  529.                 lHitType = HIT_TYPE_DOWN_ARROW
  530.         End Select
  531.     End If
  532. End Function
  533.  
  534. Private Sub ScrollUp()
  535.     Dim lStartY As Long
  536.     Dim lStopY As Long
  537.     Dim lTopOfGroupY As Long
  538.     Dim lPixelCount As Long
  539.     Dim lResult As Long
  540.     Dim lMax As Long
  541.     Dim hDestDC As Long
  542.     Dim hSrcDC As Long
  543.     Dim lWidth As Long
  544.     Dim lPixel As Long
  545.     Const PIXELS_TO_SCROLL = 64
  546.     Const PIXELS_PER_BITBLT_S = 2
  547.     
  548.     On Error Resume Next
  549.     With colMenus.Item(mlMenuCur)
  550.         .TopMenuItem = .TopMenuItem - 1
  551.         ' the upbutton is visible, hide it so it doesn't scroll
  552.         .HideButton TYPE_UP, mlMenuCur
  553.     End With
  554.     
  555.     ' setup variables
  556.     lMax = colMenus.Count
  557.     With picMenu
  558.         hDestDC = .hdc
  559.         .ScaleMode = vbPixels
  560.         .ForeColor = vbButtonText
  561.         lWidth = .ScaleWidth
  562.         lStartY = mlMenuCur * mlButtonHeight
  563.         lStopY = .ScaleHeight - (lMax - mlMenuCur) * mlButtonHeight
  564.     End With
  565.     hSrcDC = picCache.hdc
  566.     
  567.     If lMax = 0 Or hDestDC = 0 Or hSrcDC = 0 Then
  568.         Exit Sub
  569.     End If
  570.     
  571.     For lPixel = 1 To PIXELS_TO_SCROLL \ PIXELS_PER_BITBLT_S
  572.         
  573.         ' move the screen up
  574. #If USE_WING Then
  575.         lResult = WinGBitBlt(hDestDC, 0, _
  576.             lStartY + PIXELS_PER_BITBLT_S, _
  577.             lWidth, _
  578.             lStopY - lStartY - 2, _
  579.             hDestDC, 0, lStartY)
  580. #Else
  581.         lResult = BitBlt(hDestDC, 0, _
  582.             lStartY + PIXELS_PER_BITBLT_S, _
  583.             lWidth, _
  584.             lStopY - lStartY - 2, _
  585.             hDestDC, 0, lStartY, SRCCOPY)
  586. #End If
  587.  
  588.         ' repaint the background
  589. #If USE_WING Then
  590.         lResult = WinGBitBlt(hDestDC, 0, _
  591.             lStartY, _
  592.             lWidth, _
  593.             PIXELS_PER_BITBLT_S, _
  594.             hSrcDC, 0, mlButtonHeight + 3)
  595. #Else
  596.         lResult = BitBlt(hDestDC, 0, _
  597.             lStartY, _
  598.             lWidth, _
  599.             PIXELS_PER_BITBLT_S, _
  600.             hSrcDC, 0, mlButtonHeight + 3, SRCCOPY)
  601. #End If
  602.  
  603.         lPixelCount = lPixelCount + PIXELS_PER_BITBLT_S
  604.     Next
  605.     
  606.     DrawIcons
  607.     SetMenuButtonsHotSpot
  608. End Sub
  609.  
  610. Private Sub ScrollDown()
  611.     Dim lStartY As Long
  612.     Dim lStopY As Long
  613.     Dim lTopOfGroupY As Long
  614.     Dim lPixelCount As Long
  615.     Dim lResult As Long
  616.     Dim lMax As Long
  617.     Dim hDestDC As Long
  618.     Dim hSrcDC As Long
  619.     Dim lWidth As Long
  620.     Dim lPixel As Long
  621.     Const PIXELS_TO_SCROLL = 64
  622.     Const PIXELS_PER_BITBLT_S = 2
  623.     
  624.     On Error Resume Next
  625.     With colMenus.Item(mlMenuCur)
  626.         .TopMenuItem = .TopMenuItem + 1
  627.         ' the down button is visible, hide it so it doesn't scroll
  628.         .HideButton TYPE_DOWN, colMenus.Count - mlMenuCur
  629.     End With
  630.     
  631.     ' setup variables
  632.     lMax = colMenus.Count
  633.     With picMenu
  634.         hDestDC = .hdc
  635.         .ScaleMode = vbPixels
  636.         .ForeColor = vbButtonText
  637.         lWidth = .ScaleWidth
  638.         lStopY = mlMenuCur * mlButtonHeight
  639.         lStartY = .ScaleHeight - (lMax - mlMenuCur) * mlButtonHeight
  640.     End With
  641.     hSrcDC = picCache.hdc
  642.     
  643.     If lMax = 0 Or hDestDC = 0 Or hSrcDC = 0 Then
  644.         Exit Sub
  645.     End If
  646.         
  647.     For lPixel = 1 To PIXELS_TO_SCROLL \ PIXELS_PER_BITBLT_S
  648.         
  649.         ' move the screen up
  650. #If USE_WING Then
  651.         lResult = WinGBitBlt(hDestDC, 0, _
  652.             lStopY, _
  653.             lWidth, _
  654.             lStartY - lStopY, _
  655.             hDestDC, 0, lStopY + PIXELS_PER_BITBLT_S)
  656. #Else
  657.         lResult = BitBlt(hDestDC, 0, _
  658.             lStopY, _
  659.             lWidth, _
  660.             lStartY - lStopY, _
  661.             hDestDC, 0, lStopY + PIXELS_PER_BITBLT_S, SRCCOPY)
  662. #End If
  663.  
  664.         ' repaint the background
  665. #If USE_WING Then
  666.         lResult = WinGBitBlt(hDestDC, 0, _
  667.             lStartY - PIXELS_PER_BITBLT_S, _
  668.             lWidth, _
  669.             PIXELS_PER_BITBLT_S, _
  670.             hSrcDC, 0, mlButtonHeight + 3)
  671. #Else
  672.         lResult = BitBlt(hDestDC, 0, _
  673.             lStartY - PIXELS_PER_BITBLT_S, _
  674.             lWidth, _
  675.             PIXELS_PER_BITBLT_S, _
  676.             hSrcDC, 0, mlButtonHeight + 3, SRCCOPY)
  677. #End If
  678.  
  679.         lPixelCount = lPixelCount + PIXELS_PER_BITBLT_S
  680.     Next
  681.     
  682.     ' redraw the icons
  683.     DrawIcons
  684.     SetMenuButtonsHotSpot
  685. End Sub
  686.  
  687. Private Function IconStart() As Long
  688.     Dim l As Long
  689.     Dim lIconStart As Long
  690.     
  691.     On Error Resume Next
  692.     
  693.     ' calculate the offset for our first icon
  694.     For l = 1 To mlMenuCur - 1
  695.         lIconStart = lIconStart + colMenus.Item(l).MenuItemCount
  696.     Next
  697.     IconStart = lIconStart + colMenus.Item(mlMenuCur).TopMenuItem - 1
  698. End Function
  699.  
  700. Private Function ClipY() As Long
  701.     On Error Resume Next
  702.     
  703.     ' calculate the clipping area where the menu bottoms start at the bottom of picmenu
  704.     With picMenu
  705.         .ScaleMode = vbPixels
  706.         ClipY = .ScaleHeight - ((colMenus.Count) - mlMenuCur) * mlButtonHeight
  707.     End With
  708. End Function
  709.