home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / School_Man20924211302007.psc / prischo / ctrl_PullDownMenu.ctl < prev    next >
Text File  |  2007-11-21  |  6KB  |  203 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ctrl_PullDownMenu 
  3.    ClientHeight    =   360
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   5325
  7.    ScaleHeight     =   360
  8.    ScaleWidth      =   5325
  9.    Begin VB.Line lin_Line 
  10.       Visible         =   0   'False
  11.       X1              =   2040
  12.       X2              =   3240
  13.       Y1              =   0
  14.       Y2              =   0
  15.    End
  16.    Begin VB.Shape shp_MouseMove 
  17.       Height          =   255
  18.       Left            =   1200
  19.       Top             =   0
  20.       Visible         =   0   'False
  21.       Width           =   855
  22.    End
  23.    Begin VB.Label lbl_Item 
  24.       Alignment       =   2  'Center
  25.       BackStyle       =   0  'Transparent
  26.       Caption         =   "Item"
  27.       BeginProperty Font 
  28.          Name            =   "MS Sans Serif"
  29.          Size            =   8.25
  30.          Charset         =   0
  31.          Weight          =   700
  32.          Underline       =   0   'False
  33.          Italic          =   0   'False
  34.          Strikethrough   =   0   'False
  35.       EndProperty
  36.       Height          =   195
  37.       Index           =   0
  38.       Left            =   120
  39.       TabIndex        =   0
  40.       Top             =   120
  41.       Visible         =   0   'False
  42.       Width           =   300
  43.    End
  44.    Begin VB.Shape shp_Border 
  45.       Height          =   495
  46.       Left            =   0
  47.       Top             =   0
  48.       Width           =   1215
  49.    End
  50. End
  51. Attribute VB_Name = "ctrl_PullDownMenu"
  52. Attribute VB_GlobalNameSpace = False
  53. Attribute VB_Creatable = True
  54. Attribute VB_PredeclaredId = False
  55. Attribute VB_Exposed = False
  56. Option Explicit
  57. Const DefForeColor = 0
  58. Const DefBackColor = 0
  59. Const DefHideBorder = 0
  60.  
  61. Dim v_oForeColor As OLE_COLOR
  62. Dim v_oBackColor As OLE_COLOR
  63. Dim v_bHideBorder As Boolean
  64. Dim v_iItemCount As Integer
  65.  
  66. Public pSelectionLeft, pSelectionBottom As Integer
  67.  
  68. Event Click(Index As Integer)
  69. Event MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  70.  
  71. Private Sub lbl_Item_Click(Index As Integer)
  72.     RaiseEvent Click(Index)
  73. End Sub
  74.  
  75. Private Sub lbl_Item_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
  76.     With UserControl
  77.         RaiseEvent MouseMove(Index, Button, Shift, x, y)
  78.         .shp_MouseMove.Left = .lbl_Item(Index).Left - 15
  79.         .shp_MouseMove.Width = .lbl_Item(Index).Width + 30
  80.         .shp_MouseMove.Visible = True
  81.         
  82.         pSelectionLeft = .shp_MouseMove.Left
  83.         pSelectionBottom = .shp_MouseMove.Top + .shp_MouseMove.Height
  84.     End With
  85. End Sub
  86.  
  87. Private Sub UserControl_Initialize()
  88.     With UserControl
  89.         .shp_Border.Width = .Width
  90.         .shp_Border.Height = 360
  91.         .lin_Line.x1 = 0
  92.         .lin_Line.Y1 = .Height - 15
  93.         .lin_Line.X2 = .Width
  94.         .lin_Line.Y2 = .lin_Line.Y1
  95.         .lbl_Item(0).Left = -260
  96.         
  97.         .shp_MouseMove.Top = 45
  98.         .shp_MouseMove.Height = 260
  99.     End With
  100. End Sub
  101.  
  102. Private Sub UserControl_Resize()
  103.     Call UserControl_Initialize
  104. End Sub
  105.  
  106. Public Sub AddItem(m_Item As String)
  107.     With UserControl
  108.         v_iItemCount = v_iItemCount + 1
  109.         Load .lbl_Item(v_iItemCount)
  110.         .lbl_Item(v_iItemCount).Caption = m_Item
  111.         .lbl_Item(v_iItemCount).ForeColor = .shp_Border.BorderColor
  112.         .lbl_Item(v_iItemCount).Width = TextWidth(m_Item) + 150
  113.         .lbl_Item(v_iItemCount).Left = .lbl_Item(v_iItemCount - 1).Left + .lbl_Item(v_iItemCount - 1).Width + 75
  114.         .lbl_Item(v_iItemCount).Top = 75
  115.         .lbl_Item(v_iItemCount).Visible = True
  116.     End With
  117. End Sub
  118.  
  119. Public Sub Refresh()
  120.     Dim v_iLoop As Integer
  121.  
  122.     UserControl.BackColor = BackColor
  123.     For v_iLoop = 1 To v_iItemCount
  124.         UserControl.lbl_Item(v_iLoop).ForeColor = ForeColor
  125.     Next v_iLoop
  126.     UserControl.shp_Border.BorderColor = ForeColor
  127.     UserControl.shp_MouseMove.BorderColor = ForeColor
  128.     UserControl.lin_Line.BorderColor = ForeColor
  129. End Sub
  130.  
  131. Private Sub UnloadItems()
  132.     Dim v_iLoop As Integer
  133.     
  134.     For v_iLoop = 1 To v_iItemCount - 1
  135.         Unload UserControl.lbl_Item(v_iLoop)
  136.     Next v_iLoop
  137. End Sub
  138.  
  139. Public Property Get ForeColor() As OLE_COLOR
  140. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  141.     ForeColor = v_oForeColor
  142. End Property
  143.  
  144. Public Property Let ForeColor(ByVal m_ForeColor As OLE_COLOR)
  145.     v_oForeColor = m_ForeColor
  146.     PropertyChanged "ForeColor"
  147. End Property
  148.  
  149. Public Property Get BackColor() As OLE_COLOR
  150. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  151.     BackColor = v_oBackColor
  152. End Property
  153.  
  154. Public Property Let BackColor(ByVal m_BackColor As OLE_COLOR)
  155.     v_oBackColor = m_BackColor
  156.     PropertyChanged "BackColor"
  157. End Property
  158.  
  159. Public Property Get HideBorder() As Boolean
  160.     HideBorder = v_bHideBorder
  161. End Property
  162.  
  163. Public Property Let HideBorder(ByVal m_HideBorder As Boolean)
  164.     v_bHideBorder = m_HideBorder
  165.     PropertyChanged "HideBorder"
  166. End Property
  167.  
  168. Private Sub UserControl_InitProperties()
  169.     v_oForeColor = DefForeColor
  170.     v_oBackColor = DefBackColor
  171.     v_bHideBorder = DefHideBorder
  172. End Sub
  173.  
  174. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  175.     v_oForeColor = PropBag.ReadProperty("ForeColor", DefForeColor)
  176.     UserControl.shp_Border.BorderColor = v_oForeColor
  177.     UserControl.shp_MouseMove.BorderColor = v_oForeColor
  178.     UserControl.lin_Line.BorderColor = v_oForeColor
  179.     
  180.     v_oBackColor = PropBag.ReadProperty("BackColor", DefBackColor)
  181.     UserControl.BackColor = v_oBackColor
  182.     
  183.     v_bHideBorder = PropBag.ReadProperty("HideBorder", DefHideBorder)
  184.     If v_bHideBorder = True Then
  185.         UserControl.shp_Border.Visible = False
  186.         UserControl.lin_Line.Visible = True
  187.     Else
  188.         UserControl.shp_Border.Visible = True
  189.         UserControl.lin_Line.Visible = False
  190.     End If
  191. End Sub
  192.  
  193. Private Sub UserControl_Terminate()
  194.     Call UnloadItems
  195. End Sub
  196.  
  197. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  198.     Call PropBag.WriteProperty("ForeColor", v_oForeColor, DefForeColor)
  199.     Call PropBag.WriteProperty("BackColor", v_oBackColor, DefBackColor)
  200.     Call PropBag.WriteProperty("HideBorder", v_bHideBorder, DefHideBorder)
  201. End Sub
  202.  
  203.