home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / LIBRARY_AN212571932008.psc / LibSys1 / Controls / b8SideTab.ctl < prev    next >
Text File  |  2008-02-13  |  23KB  |  680 lines
  1. VERSION 5.00
  2. Begin VB.UserControl b8SideTab 
  3.    BackColor       =   &H00FFFFFF&
  4.    ClientHeight    =   5355
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   5040
  8.    ControlContainer=   -1  'True
  9.    ScaleHeight     =   357
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   336
  12.    Begin VB.Timer timerMouse 
  13.       Enabled         =   0   'False
  14.       Interval        =   1
  15.       Left            =   3465
  16.       Top             =   2235
  17.    End
  18.    Begin VB.PictureBox bgCaption 
  19.       Appearance      =   0  'Flat
  20.       BackColor       =   &H00C25418&
  21.       BorderStyle     =   0  'None
  22.       ForeColor       =   &H80000008&
  23.       Height          =   345
  24.       Left            =   660
  25.       ScaleHeight     =   23
  26.       ScaleMode       =   3  'Pixel
  27.       ScaleWidth      =   197
  28.       TabIndex        =   0
  29.       Top             =   1170
  30.       Width           =   2955
  31.       Begin VB.Image imgLeft 
  32.          Height          =   345
  33.          Left            =   2625
  34.          Picture         =   "b8SideTab.ctx":0000
  35.          Top             =   0
  36.          Width           =   15
  37.       End
  38.       Begin VB.Label lblCaption 
  39.          Alignment       =   2  'Center
  40.          BackStyle       =   0  'Transparent
  41.          Caption         =   "b8SideTab"
  42.          BeginProperty Font 
  43.             Name            =   "Tahoma"
  44.             Size            =   8.25
  45.             Charset         =   0
  46.             Weight          =   700
  47.             Underline       =   0   'False
  48.             Italic          =   0   'False
  49.             Strikethrough   =   0   'False
  50.          EndProperty
  51.          ForeColor       =   &H00FFFFFF&
  52.          Height          =   195
  53.          Left            =   90
  54.          TabIndex        =   1
  55.          Top             =   60
  56.          Width           =   2685
  57.       End
  58.       Begin VB.Image imgTitleBG 
  59.          Height          =   345
  60.          Left            =   615
  61.          Picture         =   "b8SideTab.ctx":0041
  62.          Stretch         =   -1  'True
  63.          Top             =   30
  64.          Width           =   1290
  65.       End
  66.    End
  67.    Begin VB.Image imgHand 
  68.       Height          =   480
  69.       Left            =   0
  70.       Picture         =   "b8SideTab.ctx":00DF
  71.       Top             =   0
  72.       Visible         =   0   'False
  73.       Width           =   480
  74.    End
  75.    Begin VB.Image imgLeft1 
  76.       Height          =   345
  77.       Left            =   3375
  78.       Picture         =   "b8SideTab.ctx":09A9
  79.       Top             =   3195
  80.       Visible         =   0   'False
  81.       Width           =   15
  82.    End
  83.    Begin VB.Image imgLeft2 
  84.       Height          =   345
  85.       Left            =   2250
  86.       Picture         =   "b8SideTab.ctx":09EA
  87.       Top             =   3855
  88.       Visible         =   0   'False
  89.       Width           =   15
  90.    End
  91.    Begin VB.Image imgConLeft 
  92.       Height          =   345
  93.       Left            =   3780
  94.       Picture         =   "b8SideTab.ctx":0A2B
  95.       Stretch         =   -1  'True
  96.       Top             =   960
  97.       Width           =   15
  98.    End
  99.    Begin VB.Image iLeft 
  100.       Height          =   345
  101.       Left            =   0
  102.       Picture         =   "b8SideTab.ctx":0A6C
  103.       Stretch         =   -1  'True
  104.       Top             =   0
  105.       Width           =   15
  106.    End
  107.    Begin VB.Image imgbg3 
  108.       Height          =   345
  109.       Left            =   2700
  110.       Picture         =   "b8SideTab.ctx":0AAD
  111.       Stretch         =   -1  'True
  112.       Top             =   4785
  113.       Visible         =   0   'False
  114.       Width           =   1125
  115.    End
  116.    Begin VB.Image imgbg1 
  117.       Height          =   345
  118.       Left            =   2940
  119.       Picture         =   "b8SideTab.ctx":0B4B
  120.       Stretch         =   -1  'True
  121.       Top             =   4185
  122.       Visible         =   0   'False
  123.       Width           =   1290
  124.    End
  125.    Begin VB.Image imgbg2 
  126.       Height          =   345
  127.       Left            =   885
  128.       Picture         =   "b8SideTab.ctx":0BE9
  129.       Stretch         =   -1  'True
  130.       Top             =   4440
  131.       Visible         =   0   'False
  132.       Width           =   1065
  133.    End
  134.    Begin VB.Shape shpBorder 
  135.       Height          =   1485
  136.       Left            =   300
  137.       Top             =   2460
  138.       Width           =   1755
  139.    End
  140. End
  141. Attribute VB_Name = "b8SideTab"
  142. Attribute VB_GlobalNameSpace = False
  143. Attribute VB_Creatable = True
  144. Attribute VB_PredeclaredId = False
  145. Attribute VB_Exposed = False
  146. 'code by:
  147. 'Vincent J. Jamero
  148. 'bob8choi@yahoo.com
  149.  
  150.  
  151. Option Explicit
  152. 'Default Property Values:
  153. Const m_def_ContractedForeColor = &HC25418
  154. Const m_def_ExpandedForeColor = &HFFFFFF
  155. Const m_def_Enabled = True
  156. Const m_def_AutoExpand = True
  157. Const m_def_ResizeAni = True
  158. Const m_def_Expanded = False
  159. Const m_def_MaxHeight = 0
  160. 'Property Variables:
  161. Dim m_ContractedForeColor As OLE_COLOR
  162. Dim m_ExpandedForeColor As OLE_COLOR
  163. Dim m_Enabled As Boolean
  164. Dim m_AutoExpand As Boolean
  165. Dim m_ResizeAni As Boolean
  166. Dim m_Expanded As Boolean
  167. Dim m_MaxHeight As Integer
  168.  
  169. 'apis
  170. Private Declare Function GetTickCount Lib "kernel32" () As Long
  171.  
  172.  
  173. 'Event Declarations:
  174. Event CaptionMouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=lblCaption,lblCaption,-1,MouseUp
  175. Attribute CaptionMouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  176. Event CompleteContract()
  177. Event CompleteExpand()
  178. Event Resize() 'MappingInfo=UserControl,UserControl,-1,Resize
  179. Attribute Resize.VB_Description = "Occurs when a form is first displayed or the size of an object changes."
  180. Event CaptionClick() 'MappingInfo=lblCaption,lblCaption,-1,Click
  181. Attribute CaptionClick.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  182. Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
  183. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  184.  
  185.  
  186.  
  187.  
  188. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  189. 'MappingInfo=lblCaption,lblCaption,-1,Caption
  190. Public Property Get Caption() As String
  191. Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar or below an object's icon."
  192.     Caption = lblCaption.Caption
  193. End Property
  194.  
  195. Public Property Let Caption(ByVal New_Caption As String)
  196.     lblCaption.Caption() = New_Caption
  197.     PropertyChanged "Caption"
  198. End Property
  199.  
  200.  
  201. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  202. 'MappingInfo=lblCaption,lblCaption,-1,Font
  203. Public Property Get Font() As Font
  204. Attribute Font.VB_Description = "Returns a Font object."
  205. Attribute Font.VB_UserMemId = -512
  206.     Set Font = lblCaption.Font
  207. End Property
  208.  
  209. Public Property Set Font(ByVal New_Font As Font)
  210.     Set lblCaption.Font = New_Font
  211.     Set UserControl.Font = New_Font
  212.     PropertyChanged "Font"
  213. End Property
  214.  
  215. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  216. 'MappingInfo=lblCaption,lblCaption,-1,FontBold
  217. Public Property Get FontBold() As Boolean
  218. Attribute FontBold.VB_Description = "Returns/sets bold font styles."
  219.     FontBold = lblCaption.FontBold
  220. End Property
  221.  
  222. Public Property Let FontBold(ByVal New_FontBold As Boolean)
  223.     lblCaption.FontBold() = New_FontBold
  224.     PropertyChanged "FontBold"
  225. End Property
  226.  
  227. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  228. 'MappingInfo=lblCaption,lblCaption,-1,FontItalic
  229. Public Property Get FontItalic() As Boolean
  230. Attribute FontItalic.VB_Description = "Returns/sets italic font styles."
  231.     FontItalic = lblCaption.FontItalic
  232. End Property
  233.  
  234. Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
  235.     lblCaption.FontItalic() = New_FontItalic
  236.     PropertyChanged "FontItalic"
  237. End Property
  238.  
  239. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  240. 'MappingInfo=lblCaption,lblCaption,-1,FontName
  241. Public Property Get FontName() As String
  242. Attribute FontName.VB_Description = "Specifies the name of the font that appears in each row for the given level."
  243.     FontName = lblCaption.FontName
  244. End Property
  245.  
  246. Public Property Let FontName(ByVal New_FontName As String)
  247.     lblCaption.FontName() = New_FontName
  248.     PropertyChanged "FontName"
  249. End Property
  250.  
  251. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  252. 'MappingInfo=lblCaption,lblCaption,-1,FontSize
  253. Public Property Get FontSize() As Single
  254. Attribute FontSize.VB_Description = "Specifies the size (in points) of the font that appears in each row for the given level."
  255.     FontSize = lblCaption.FontSize
  256. End Property
  257.  
  258. Public Property Let FontSize(ByVal New_FontSize As Single)
  259.     lblCaption.FontSize() = New_FontSize
  260.     PropertyChanged "FontSize"
  261. End Property
  262.  
  263. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  264. 'MappingInfo=lblCaption,lblCaption,-1,FontStrikethru
  265. Public Property Get FontStrikethru() As Boolean
  266. Attribute FontStrikethru.VB_Description = "Returns/sets strikethrough font styles."
  267.     FontStrikethru = lblCaption.FontStrikethru
  268. End Property
  269.  
  270. Public Property Let FontStrikethru(ByVal New_FontStrikethru As Boolean)
  271.     lblCaption.FontStrikethru() = New_FontStrikethru
  272.     PropertyChanged "FontStrikethru"
  273. End Property
  274.  
  275. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  276. 'MappingInfo=lblCaption,lblCaption,-1,FontUnderline
  277. Public Property Get FontUnderline() As Boolean
  278. Attribute FontUnderline.VB_Description = "Returns/sets underline font styles."
  279.     FontUnderline = lblCaption.FontUnderline
  280. End Property
  281.  
  282. Public Property Let FontUnderline(ByVal New_FontUnderline As Boolean)
  283.     lblCaption.FontUnderline() = New_FontUnderline
  284.     PropertyChanged "FontUnderline"
  285. End Property
  286.  
  287. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  288. 'MappingInfo=lblCaption,lblCaption,-1,ForeColor
  289. Public Property Get ForeColor() As OLE_COLOR
  290. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  291.     ForeColor = lblCaption.ForeColor
  292. End Property
  293.  
  294. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  295.     lblCaption.ForeColor() = New_ForeColor
  296.     PropertyChanged "ForeColor"
  297. End Property
  298.  
  299. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  300. 'MemberInfo=7,0,0,0
  301. Public Property Get MaxHeight() As Integer
  302.     MaxHeight = m_MaxHeight
  303. End Property
  304.  
  305. Public Property Let MaxHeight(ByVal New_MaxHeight As Integer)
  306.     m_MaxHeight = New_MaxHeight
  307.     PropertyChanged "MaxHeight"
  308. End Property
  309.  
  310.  
  311.  
  312.  
  313. 'Initialize Properties for User Control
  314. Private Sub UserControl_InitProperties()
  315.     m_MaxHeight = m_def_MaxHeight
  316.     m_Expanded = m_def_Expanded
  317.     m_ResizeAni = m_def_ResizeAni
  318.     m_AutoExpand = m_def_AutoExpand
  319.     m_Enabled = m_def_Enabled
  320.     m_ContractedForeColor = m_def_ContractedForeColor
  321.     m_ExpandedForeColor = m_def_ExpandedForeColor
  322. End Sub
  323.  
  324. 'Load property values from storage
  325. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  326.  
  327.     lblCaption.Caption = PropBag.ReadProperty("Caption", "b8SideTab")
  328.     Set lblCaption.Font = PropBag.ReadProperty("Font", Ambient.Font)
  329.     lblCaption.FontBold = PropBag.ReadProperty("FontBold", 0)
  330.     lblCaption.FontItalic = PropBag.ReadProperty("FontItalic", 0)
  331.     lblCaption.FontName = PropBag.ReadProperty("FontName", lblCaption.FontName)
  332.     lblCaption.FontSize = PropBag.ReadProperty("FontSize", lblCaption.FontSize)
  333.     lblCaption.FontStrikethru = PropBag.ReadProperty("FontStrikethru", 0)
  334.     lblCaption.FontUnderline = PropBag.ReadProperty("FontUnderline", 0)
  335.     lblCaption.ForeColor = PropBag.ReadProperty("ForeColor", &H30A0B8)
  336.     m_MaxHeight = PropBag.ReadProperty("MaxHeight", m_def_MaxHeight)
  337.     m_Expanded = PropBag.ReadProperty("Expanded", m_def_Expanded)
  338.     m_ResizeAni = PropBag.ReadProperty("ResizeAni", m_def_ResizeAni)
  339.     shpBorder.BorderColor = PropBag.ReadProperty("BorderColor", &H80000008)
  340.     m_AutoExpand = PropBag.ReadProperty("AutoExpand", m_def_AutoExpand)
  341.     m_Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  342.     m_ContractedForeColor = PropBag.ReadProperty("ContractedForeColor", m_def_ContractedForeColor)
  343.     m_ExpandedForeColor = PropBag.ReadProperty("ExpandedForeColor", m_def_ExpandedForeColor)
  344.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &HFFFFFF)
  345. End Sub
  346.  
  347. Private Sub UserControl_Resize()
  348.     
  349. On Error Resume Next
  350.  
  351.     iLeft.Move 0, 0, iLeft.Width, GetHeight
  352.  
  353.     bgCaption.Move iLeft.Width, 0, GetWidth - iLeft.Width
  354.     
  355.     imgLeft.Move bgCaption.Width - imgLeft.Width, 0
  356.     
  357.     imgTitleBG.Move 0, 0, bgCaption.Width - imgLeft.Width
  358.     
  359.     lblCaption.Move iLeft.Width, 4, GetWidth
  360.  
  361.     imgConLeft.Move GetWidth - imgConLeft.Width, 0, imgConLeft.Width, GetHeight
  362.  
  363.         
  364.     shpBorder.Move iLeft.Width, 0, GetWidth, GetHeight
  365.      
  366.     
  367.     RaiseEvent Resize
  368.     
  369.  
  370. End Sub
  371.  
  372.  
  373.  
  374.  
  375.  
  376. 'Write property values to storage
  377. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  378.     Call PropBag.WriteProperty("Caption", lblCaption.Caption, "b8SideTab")
  379.     Call PropBag.WriteProperty("Font", lblCaption.Font, Ambient.Font)
  380.     Call PropBag.WriteProperty("FontBold", lblCaption.FontBold, 0)
  381.     Call PropBag.WriteProperty("FontItalic", lblCaption.FontItalic, 0)
  382.     Call PropBag.WriteProperty("FontName", lblCaption.FontName, "")
  383.     Call PropBag.WriteProperty("FontSize", lblCaption.FontSize, 0)
  384.     Call PropBag.WriteProperty("FontStrikethru", lblCaption.FontStrikethru, 0)
  385.     Call PropBag.WriteProperty("FontUnderline", lblCaption.FontUnderline, 0)
  386.     Call PropBag.WriteProperty("ForeColor", lblCaption.ForeColor, &H30A0B8)
  387.     Call PropBag.WriteProperty("MaxHeight", m_MaxHeight, m_def_MaxHeight)
  388.     Call PropBag.WriteProperty("Expanded", m_Expanded, m_def_Expanded)
  389.     Call PropBag.WriteProperty("ResizeAni", m_ResizeAni, m_def_ResizeAni)
  390.     Call PropBag.WriteProperty("BorderColor", shpBorder.BorderColor, &H80000008)
  391.     Call PropBag.WriteProperty("AutoExpand", m_AutoExpand, m_def_AutoExpand)
  392.     Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
  393.     Call PropBag.WriteProperty("ContractedForeColor", m_ContractedForeColor, m_def_ContractedForeColor)
  394.     Call PropBag.WriteProperty("ExpandedForeColor", m_ExpandedForeColor, m_def_ExpandedForeColor)
  395.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &HFFFFFF)
  396. End Sub
  397.  
  398. Private Function GetWidth() As Integer
  399.     GetWidth = UserControl.Width / Screen.TwipsPerPixelY
  400. End Function
  401. Private Function GetHeight() As Integer
  402.     GetHeight = UserControl.Height / Screen.TwipsPerPixelX
  403. End Function
  404. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  405. 'MemberInfo=0,0,2,false
  406. Public Property Get Expanded() As Boolean
  407. Attribute Expanded.VB_MemberFlags = "400"
  408.     Expanded = m_Expanded
  409. End Property
  410.  
  411. Public Property Let Expanded(ByVal New_Expanded As Boolean)
  412.     If Ambient.UserMode = False Then Err.Raise 387
  413.     
  414.     Dim NewHeight As Integer
  415.     Dim st As Single
  416.     Dim StepSize As Integer
  417.     Dim oldColor As OLE_COLOR
  418.     Dim ContractSize As Integer
  419.    
  420.     If New_Expanded = False Then
  421.     
  422.         UserControl.Height = Screen.TwipsPerPixelY * (bgCaption.Height)
  423.         m_Expanded = False
  424.         Set imgTitleBG.Picture = imgbg2.Picture
  425.         Set imgLeft.Picture = imgLeft2.Picture
  426.         lblCaption.ForeColor = ContractedForeColor
  427.         RaiseEvent CompleteContract
  428.     Else
  429.     
  430.         'set images
  431.         Set imgTitleBG.Picture = imgbg1.Picture
  432.         Set imgLeft.Picture = imgLeft1.Picture
  433.         imgConLeft.Move GetWidth - imgConLeft.Width, 0, imgConLeft.Width, GetHeight
  434.         
  435.         If ResizeAni = True Then
  436.             
  437.             NewHeight = MaxHeight
  438.             
  439.             
  440.             If NewHeight > UserControl.Height Then
  441.             
  442.                 
  443.                 StepSize = (NewHeight - UserControl.Height) / Screen.TwipsPerPixelY * 2
  444.             
  445.                 While UserControl.Height < NewHeight
  446.                 
  447.                     UserControl.Height = UserControl.Height + StepSize
  448.                     DoEvents
  449.                     
  450.                     st = GetTickCount + 4
  451.                     While st > GetTickCount
  452.                         
  453.                     Wend
  454.                 Wend
  455.  
  456.  
  457.                 m_Expanded = True
  458.                 Set imgTitleBG.Picture = imgbg1.Picture
  459.                 Set imgLeft.Picture = imgLeft1.Picture
  460.                 imgConLeft.Move GetWidth - imgConLeft.Width, 0, imgConLeft.Width, GetHeight
  461.                 lblCaption.ForeColor = ExpandedForeColor
  462.                 RaiseEvent CompleteExpand
  463.                 
  464.             Else
  465.             
  466.                m_Expanded = False
  467.             End If
  468.             
  469.         Else
  470.             UserControl.Height = MaxHeight
  471.         End If
  472.         
  473.     End If
  474.     
  475.     
  476.     
  477.     PropertyChanged "Expanded"
  478. End Property
  479.  
  480. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  481. 'MemberInfo=0,0,0,true
  482. Public Property Get ResizeAni() As Boolean
  483.     ResizeAni = m_ResizeAni
  484. End Property
  485.  
  486. Public Property Let ResizeAni(ByVal New_ResizeAni As Boolean)
  487.     m_ResizeAni = New_ResizeAni
  488.     PropertyChanged "ResizeAni"
  489. End Property
  490. '
  491. ''WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  492. ''MappingInfo=UserControl,UserControl,-1,BackColor
  493. 'Public Property Get BorderColor() As OLE_COLOR
  494. '    BorderColor = UserControl.BackColor
  495. 'End Property
  496. '
  497. 'Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)
  498. '    UserControl.BackColor() = New_BorderColor
  499. '    PropertyChanged "BorderColor"
  500. 'End Property
  501. '
  502. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  503. 'MappingInfo=shpBorder,shpBorder,-1,BorderColor
  504. Public Property Get BorderColor() As OLE_COLOR
  505. Attribute BorderColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  506.     BorderColor = shpBorder.BorderColor
  507. End Property
  508.  
  509. Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)
  510.     shpBorder.BorderColor() = New_BorderColor
  511.     PropertyChanged "BorderColor"
  512. End Property
  513.  
  514. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  515. 'MemberInfo=0,0,0,true
  516. Public Property Get AutoExpand() As Boolean
  517.     AutoExpand = m_AutoExpand
  518. End Property
  519.  
  520. Public Property Let AutoExpand(ByVal New_AutoExpand As Boolean)
  521.     m_AutoExpand = New_AutoExpand
  522.     PropertyChanged "AutoExpand"
  523. End Property
  524.  
  525.  
  526.  
  527.  
  528.  
  529.  
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  
  536.  
  537.  
  538.  
  539.  
  540.  
  541. Public Sub HideExpand()
  542.     
  543.     Dim NewHeight As Integer
  544.     Dim st As Single
  545.     Dim StepSize As Integer
  546.     Dim oldColor As OLE_COLOR
  547.  
  548.     
  549.     If Expanded = True Then
  550.         UserControl.Height = Screen.TwipsPerPixelX * (bgCaption.Height)
  551.         m_Expanded = False
  552.         Set imgTitleBG.Picture = imgbg2.Picture
  553.         Set imgLeft.Picture = imgLeft2.Picture
  554.         lblCaption.ForeColor = ContractedForeColor
  555.         RaiseEvent CompleteContract
  556.     Else
  557.         
  558.         If ResizeAni = True Then
  559.             NewHeight = MaxHeight
  560.             If NewHeight > UserControl.Height Then
  561.             
  562.  
  563.                 
  564.                 StepSize = (NewHeight - UserControl.Height) / Screen.TwipsPerPixelY * 2
  565.                 While UserControl.Height < NewHeight
  566.                 
  567.                     UserControl.Height = UserControl.Height + StepSize
  568.                     st = GetTickCount + 4
  569.                     While st > GetTickCount
  570.                         DoEvents
  571.                     Wend
  572.                 Wend
  573.  
  574.     
  575.                 m_Expanded = True
  576.                 Set imgTitleBG.Picture = imgbg1.Picture
  577.                 Set imgLeft.Picture = imgLeft1.Picture
  578.                 imgConLeft.Move GetWidth - imgConLeft.Width, 0, imgConLeft.Width, GetHeight
  579.                 lblCaption.ForeColor = ExpandedForeColor
  580.                 RaiseEvent CompleteExpand
  581.             Else
  582.                 m_Expanded = False
  583.                 lblCaption.ForeColor = ContractedForeColor
  584.             End If
  585.             
  586.         Else
  587.             UserControl.Height = MaxHeight
  588.             m_Expanded = True
  589.             lblCaption.ForeColor = ExpandedForeColor
  590.             RaiseEvent CompleteExpand
  591.         End If
  592.         
  593.     End If
  594.  
  595. End Sub
  596. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  597. 'MemberInfo=0,0,0,True
  598. Public Property Get Enabled() As Boolean
  599. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  600.     Enabled = m_Enabled
  601. End Property
  602.  
  603. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  604.     Dim ConCtrl As Control
  605.     On Error Resume Next
  606.     
  607.     For Each ConCtrl In UserControl.ContainedControls
  608.         ConCtrl.Enabled = New_Enabled
  609.     Next
  610.     
  611.     m_Enabled = New_Enabled
  612.     PropertyChanged "Enabled"
  613. End Property
  614.  
  615. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  616. 'MappingInfo=UserControl,UserControl,-1,Controls
  617. Public Property Get ContainedControls() As Object
  618. Attribute ContainedControls.VB_Description = "A collection whose elements represent each control on a form, including elements of control arrays. "
  619.     Set Controls = UserControl.ContainedControls
  620.     
  621. End Property
  622.  
  623.  
  624.  
  625.  
  626. Private Sub lblCaption_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  627.     If m_AutoExpand = True Then
  628.         If m_Expanded = True Then
  629.             Expanded = False
  630.         Else
  631.             Expanded = True
  632.         End If
  633.     End If
  634.     RaiseEvent CaptionMouseUp(Button, Shift, X, Y)
  635. End Sub
  636.  
  637. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  638. 'MemberInfo=10,0,0,0
  639. Public Property Get ContractedForeColor() As OLE_COLOR
  640.     ContractedForeColor = m_ContractedForeColor
  641. End Property
  642.  
  643. Public Property Let ContractedForeColor(ByVal New_ContractedForeColor As OLE_COLOR)
  644.     m_ContractedForeColor = New_ContractedForeColor
  645.     PropertyChanged "ContractedForeColor"
  646. End Property
  647.  
  648. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  649. 'MemberInfo=10,0,0,0
  650. Public Property Get ExpandedForeColor() As OLE_COLOR
  651.     ExpandedForeColor = m_ExpandedForeColor
  652. End Property
  653.  
  654. Public Property Let ExpandedForeColor(ByVal New_ExpandedForeColor As OLE_COLOR)
  655.     m_ExpandedForeColor = New_ExpandedForeColor
  656.     PropertyChanged "ExpandedForeColor"
  657. End Property
  658.  
  659.  
  660. Private Function MeMouseOnOver()
  661.     UserControl.Parent.MouseIcon = imgHand.Picture
  662.     UserControl.Parent.MousePointer = vbCustom
  663.  
  664.     imgTitleBG.Picture = imgbg3.Picture
  665.     timerMouse.Enabled = True
  666. End Function
  667.  
  668. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  669. 'MappingInfo=UserControl,UserControl,-1,BackColor
  670. Public Property Get BackColor() As OLE_COLOR
  671. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  672.     BackColor = UserControl.BackColor
  673. End Property
  674.  
  675. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  676.     UserControl.BackColor() = New_BackColor
  677.     PropertyChanged "BackColor"
  678. End Property
  679.  
  680.