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 / clsMenuItem.cls < prev    next >
Text File  |  2008-01-20  |  12KB  |  430 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 = "clsMenuItem"
  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 Type
  17. Private Type ButtonStruct
  18.    Rect                  As Rect
  19.    State                 As Long
  20.    OnScreen              As Boolean
  21. End Type
  22.  
  23. ' Private Variables
  24. Private m_ItemAlignement As AlignmentConstants
  25. Private ButtonDownOnMe   As Boolean
  26. Private m_ItemValue      As Boolean
  27. Private m_ButtonStruct   As ButtonStruct
  28. Private m_Index          As Integer
  29. Private m_ItemType       As ItemTypes
  30. Private m_ButtonHeight   As Long
  31. Private m_ItemForeColor  As Long
  32. Private picIcon          As StdPicture
  33. Private picCache         As PictureBox
  34. Private picMenu          As PictureBox
  35. Private HitBorder        As Rect
  36. Private IconBorder       As Rect
  37. Private m_Caption        As String
  38. Private m_Key            As String
  39. Private m_Tag            As String
  40. Private m_ToolTipText    As String
  41.  
  42. ' Private API's
  43. Private Declare Function CreateRectRgnIndirect Lib "GDI32" (lpRect As Rect) As Long
  44. Private Declare Function DeleteObject Lib "GDI32" (ByVal hMF As Long) As Long
  45. Private Declare Function RestoreDC Lib "GDI32" (ByVal hDC As Long, ByVal SavedDC As Long) As Long
  46. Private Declare Function SaveDC Lib "GDI32" (ByVal hDC As Long) As Long
  47. Private Declare Function SelectClipRgn Lib "GDI32" (ByVal hDC As Long, ByVal hRgn As Long) As Long
  48.  
  49. Public Property Let ButtonHeight(ByVal NewButtonHeight As Long)
  50.  
  51.    m_ButtonHeight = NewButtonHeight
  52.  
  53. End Property
  54.  
  55. Public Property Set Cache(ByRef NewCache As PictureBox)
  56.  
  57.    Set picCache = NewCache
  58.  
  59. End Property
  60.  
  61. Public Property Get Caption() As String
  62.  
  63.    Caption = m_Caption
  64.  
  65. End Property
  66.  
  67. Public Property Let Caption(ByVal NewCaption As String)
  68.  
  69.    m_Caption = NewCaption
  70.  
  71. End Property
  72.  
  73. Public Property Get Icon() As StdPicture
  74.  
  75.    Set Icon = picIcon
  76.  
  77. End Property
  78.  
  79. Public Property Set Icon(ByRef NewIcon As StdPicture)
  80.  
  81.    Set picIcon = NewIcon
  82.  
  83. End Property
  84.  
  85. Public Property Get Index() As Integer
  86.  
  87.    Index = m_Index
  88.  
  89. End Property
  90.  
  91. Public Property Let Index(ByVal NewIndex As Integer)
  92.  
  93.    m_Index = NewIndex
  94.  
  95. End Property
  96.  
  97. Public Property Let ItemAlignment(ByVal NewItemAlignment As AlignmentConstants)
  98.  
  99.    m_ItemAlignement = NewItemAlignment
  100.  
  101. End Property
  102.  
  103. Public Property Let ItemForeColor(ByVal NewItemForeColor As Long)
  104.  
  105.    m_ItemForeColor = NewItemForeColor
  106.  
  107. End Property
  108.  
  109. Public Property Get ItemType() As ItemTypes
  110.  
  111.    ItemType = m_ItemType
  112.  
  113. End Property
  114.  
  115. Public Property Let ItemType(ByVal NewItemType As ItemTypes)
  116.  
  117.    m_ItemType = NewItemType
  118.  
  119. End Property
  120.  
  121. Public Property Get ItemValue() As Boolean
  122.  
  123.    ItemValue = m_ItemValue
  124.  
  125. End Property
  126.  
  127. Public Property Let ItemValue(ByVal NewItemValue As Boolean)
  128.  
  129.    m_ItemValue = NewItemValue
  130.    
  131.    If Not NewItemValue Then Call DrawBorder(DEFAULT)
  132.  
  133. End Property
  134.  
  135. Public Property Get Key() As String
  136.  
  137.    Key = m_Key
  138.  
  139. End Property
  140.  
  141. Public Property Let Key(ByVal NewKey As String)
  142.  
  143.    m_Key = NewKey
  144.  
  145. End Property
  146.  
  147. Public Property Set Parent(ByRef NewParent As PictureBox)
  148.  
  149.    Set picMenu = NewParent
  150.  
  151. End Property
  152.  
  153. Public Property Let State(ByVal NewState As Long)
  154.  
  155.    m_ButtonStruct.State = NewState
  156.  
  157. End Property
  158.  
  159. Public Property Get Tag() As String
  160.  
  161.    Tag = m_Tag
  162.  
  163. End Property
  164.  
  165. Public Property Let Tag(ByVal NewTag As String)
  166.  
  167.    m_Tag = NewTag
  168.  
  169. End Property
  170.  
  171. Public Property Get ToolTipText() As String
  172.  
  173.    ToolTipText = m_ToolTipText
  174.  
  175. End Property
  176.  
  177. Public Property Let ToolTipText(ByVal NewToolTipText As String)
  178.  
  179.    m_ToolTipText = NewToolTipText
  180.  
  181. End Property
  182.  
  183. Public Function DisableButton()
  184.  
  185.    m_ButtonStruct.OnScreen = False
  186.  
  187. End Function
  188.  
  189. Public Function HitTest(ByVal MousePosition As Long, ByVal X As Long, ByVal Y As Long) As Boolean
  190.  
  191.    If Not m_ButtonStruct.OnScreen Then Exit Function
  192.    
  193.    If PtInRect(HitBorder, X, Y) Then
  194.       HitTest = True
  195.       
  196.       If MousePosition = MOUSE_UP Then
  197.          If m_ItemValue Then
  198.             Call DrawBorder(SUNKEN)
  199.             
  200.          ElseIf m_ButtonStruct.State <> RAISED Then
  201.             If (m_ItemType <> CheckButton) And (m_ItemType <> OptionButton) Then Call DrawBorder(RAISED)
  202.          End If
  203.          
  204.          ButtonDownOnMe = False
  205.          
  206.       ElseIf MousePosition = MOUSE_DOWN Then
  207.          If m_ButtonStruct.State = DEFAULT Then
  208.             If Not m_ItemValue Then Call DrawBorder(RAISED)
  209.             
  210.          ElseIf m_ButtonStruct.State <> SUNKEN Then
  211.             Call DrawBorder(SUNKEN)
  212.             
  213.             ButtonDownOnMe = True
  214.          End If
  215.          
  216.       ' MOUSE_CHECK or MOUSE_MOVE
  217.       ElseIf Not m_ItemValue Then
  218.          ButtonDownOnMe = False
  219.          
  220.          If m_ButtonStruct.State = DEFAULT Then Call DrawBorder(RAISED)
  221.       End If
  222.       
  223.    Else
  224.       If MousePosition <> MOUSE_MOVE Then ButtonDownOnMe = False
  225.       If Not m_ItemValue And (m_ButtonStruct.State <> DEFAULT) Then Call DrawBorder(DEFAULT)
  226.    End If
  227.  
  228. End Function
  229.  
  230. Public Function PaintButton(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, ByRef IsShowed As Boolean) As Boolean
  231.  
  232. Dim blnClipping  As Boolean
  233. Dim lngCenter    As Long
  234. Dim lngHeight    As Long
  235. Dim lngLeft      As Long
  236. Dim lngMaxHeight As Long
  237. Dim lngTopItem   As Long
  238. Dim lngRegion    As Long
  239. Dim lngSavedDC   As Long
  240. Dim rctButton    As Rect
  241. Dim rctCaption   As Rect
  242. Dim rctRegion    As Rect
  243. Dim sngSpace     As Single
  244.  
  245.    PaintButton = True
  246.    IsShowed = False
  247.    
  248.    If m_Index < TopMenuItem Then
  249.       m_ButtonStruct.OnScreen = False
  250.       Exit Function
  251.    End If
  252.    
  253.    With picMenu
  254.       lngTopItem = m_Index - TopMenuItem + 1
  255.       sngSpace = 1 + (MENU_SPACE And (ItemIconSize = 16)) / 10
  256.       rctCaption.Bottom = .TextHeight("X")
  257.       rctCaption.Right = .TextWidth(m_Caption)
  258.       
  259.       If m_ItemAlignement = vbCenter Then
  260.          lngLeft = .ScaleWidth \ 2
  261.          
  262.       ElseIf m_ItemAlignement = vbLeftJustify Then
  263.          lngLeft = ItemIconSize \ 2 + MENU_SPACE
  264.          
  265.       Else  'vbRightJustify
  266.          lngLeft = .ScaleWidth - ItemIconSize \ 2 - MENU_SPACE
  267.       End If
  268.    End With
  269.    
  270.    With m_ButtonStruct
  271.       With .Rect
  272.          If m_ItemAlignement = vbCenter Then
  273.             .Top = m_ButtonHeight - MENU_BUTTON_MIN_HEIGHT + (lngTopItem * 2 * ItemIconSize * sngSpace) - ItemIconSize + ((lngTopItem + 1 = 1) * 4) + (CurrentMenu - 1) * m_ButtonHeight
  274.             
  275.          ' vbLeftJustify or vbRightJustify
  276.          Else
  277.             .Top = m_ButtonHeight - MENU_BUTTON_MIN_HEIGHT \ 3 + (lngTopItem * 1.5 * ItemIconSize * sngSpace) - ItemIconSize + ((lngTopItem + 1 = 1) * 4) + (CurrentMenu - 1) * m_ButtonHeight
  278.          End If
  279.          
  280.          If ButtonHideInSingleMenu Then .Top = .Top - m_ButtonHeight
  281.          
  282.          .Bottom = .Top + ItemIconSize
  283.          .Left = lngLeft - (ItemIconSize \ 2)
  284.          .Right = .Left + ItemIconSize
  285.          rctButton.Left = .Left
  286.          rctButton.Top = .Top
  287.          rctButton.Right = .Right
  288.          rctButton.Bottom = .Bottom
  289.       End With
  290.       
  291.       If rctButton.Top + MENU_SPACE > ClipHeight Then
  292.          .OnScreen = False
  293.          PaintButton = False
  294.          Exit Function
  295.       End If
  296.       
  297.       If rctButton.Bottom > ClipHeight Then
  298.          blnClipping = True
  299.          rctButton.Bottom = ClipHeight
  300.       End If
  301.       
  302.       .OnScreen = True
  303.    End With
  304.    
  305.    If m_ItemAlignement = vbCenter Then
  306.       rctCaption.Left = lngLeft - (rctCaption.Right \ 2)
  307.       rctCaption.Top = rctButton.Top + ItemIconSize + 4
  308.       lngMaxHeight = rctCaption.Top + rctCaption.Bottom
  309.       
  310.    Else
  311.       If m_ItemAlignement = vbLeftJustify Then
  312.          rctCaption.Left = lngLeft + ItemIconSize \ 2 + MENU_SPACE
  313.          
  314.       ' vbRightJustify
  315.       Else
  316.          rctCaption.Left = lngLeft - ItemIconSize \ 2 - rctCaption.Right - MENU_SPACE
  317.       End If
  318.       
  319.       ' vbLeftJustify or vbRightJustify
  320.       rctCaption.Top = rctButton.Top + (rctButton.Bottom - rctButton.Top - rctCaption.Bottom) \ 2
  321.       lngMaxHeight = m_ButtonStruct.Rect.Bottom
  322.    End If
  323.    
  324.    With HitBorder
  325.       .Left = rctButton.Left - 4 - (rctCaption.Right And m_ItemAlignement = vbRightJustify)
  326.       .Top = rctButton.Top - 4
  327.       .Right = rctButton.Right + 4 + (rctCaption.Right And m_ItemAlignement = vbLeftJustify)
  328.       .Bottom = rctButton.Bottom + 4 + (rctCaption.Bottom And (m_ItemAlignement = vbCenter))
  329.       
  330.       If blnClipping Or (.Bottom > ClipHeight) Then .Bottom = (rctButton.Bottom And (Not OnlyFullItemsHit And Not OnlyFullItemsShow))
  331.    End With
  332.    
  333.    With IconBorder
  334.       .Left = rctButton.Left - 4
  335.       .Top = rctButton.Top - 4
  336.       .Right = rctButton.Right + 4
  337.       .Bottom = rctButton.Bottom + (4 And Not blnClipping)
  338.    End With
  339.    
  340.    With m_ButtonStruct.Rect
  341.       If OnlyFullItemsShow And (lngMaxHeight > ClipHeight) Then
  342.          lngHeight = 0
  343.          
  344.       ElseIf blnClipping Then
  345.          lngHeight = rctButton.Bottom - rctButton.Top
  346.          
  347.       Else
  348.          lngHeight = ItemIconSize
  349.       End If
  350.       
  351.       If lngHeight Then
  352.          BitBlt picMenu.hDC, .Left, .Top, ItemIconSize, lngHeight, picCache.hDC, 0, m_ButtonHeight * 2 + (FirstIcon + lngTopItem) * ItemIconSize, vbSrcCopy
  353.          IsShowed = True
  354.       End If
  355.    End With
  356.    
  357.    With picMenu
  358.       .CurrentX = rctCaption.Left
  359.       .CurrentY = rctCaption.Top
  360.       .ForeColor = m_ItemForeColor
  361.       
  362.       If m_ItemAlignement = vbCenter Then
  363.          rctButton.Top = .CurrentY
  364.          
  365.       ' vbLeftJustify or vbRightJustify
  366.       Else
  367.          rctButton.Top = rctButton.Top + (ItemIconSize - rctCaption.Bottom) \ 2
  368.       End If
  369.       
  370.       If lngMaxHeight > ClipHeight Then
  371.          If Not OnlyFullItemsShow Then
  372.             rctRegion.Left = 0
  373.             rctRegion.Top = rctButton.Top
  374.             rctRegion.Right = .Width
  375.             rctRegion.Bottom = ClipHeight
  376.             lngSavedDC = SaveDC(.hDC)
  377.             lngRegion = CreateRectRgnIndirect(rctRegion)
  378.             SelectClipRgn .hDC, lngRegion
  379.             .CurrentY = rctRegion.Top
  380.             picMenu.Print m_Caption
  381.             DeleteObject lngRegion
  382.             RestoreDC .hDC, lngSavedDC
  383.          End If
  384.          
  385.          PaintButton = False
  386.          
  387.       Else
  388.          picMenu.Print m_Caption
  389.          
  390.          If Not blnClipping Then
  391.             PaintButton = True
  392.             
  393.          Else
  394.             PaintButton = False
  395.          End If
  396.       End If
  397.    End With
  398.    
  399.    If ItemValue Then Call DrawBorder(SUNKEN)
  400.  
  401. End Function
  402.  
  403. Public Sub DrawBorder(ByVal Edge As Long)
  404.  
  405.    If Not m_ButtonStruct.OnScreen Then Exit Sub
  406.    
  407.    State = Edge
  408.    
  409.    If Edge = RAISED Then
  410.       DrawEdge picMenu.hDC, IconBorder, BDR_RAISEDOUTER, BF_RECT
  411.       
  412.    ElseIf Edge = SUNKEN Then
  413.       DrawEdge picMenu.hDC, IconBorder, BDR_SUNKENINNER, BF_RECT
  414.       
  415.    ElseIf Not m_ItemValue Then
  416.       With IconBorder
  417.          picMenu.Line (.Left, .Top)-(.Right - 1, .Bottom - 1), picMenu.BackColor, B
  418.       End With
  419.    End If
  420.  
  421. End Sub
  422.  
  423. Private Sub Class_Terminate()
  424.  
  425.    Set picIcon = Nothing
  426.    Set picCache = Nothing
  427.    Set picMenu = Nothing
  428.  
  429. End Sub
  430.