home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axpanel / axpanel.ctl < prev    next >
Encoding:
Text File  |  1998-08-20  |  20.5 KB  |  615 lines
  1. VERSION 5.00
  2. Begin VB.UserControl axPanel 
  3.    Alignable       =   -1  'True
  4.    CanGetFocus     =   0   'False
  5.    ClientHeight    =   735
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   3930
  9.    ControlContainer=   -1  'True
  10.    ScaleHeight     =   735
  11.    ScaleWidth      =   3930
  12.    ToolboxBitmap   =   "axPanel.ctx":0000
  13.    Begin VB.Timer Timer 
  14.       Enabled         =   0   'False
  15.       Interval        =   1000
  16.       Left            =   3420
  17.       Top             =   0
  18.    End
  19.    Begin VB.Label lblText 
  20.       BackStyle       =   0  'Transparent
  21.       Caption         =   "lblText"
  22.       Height          =   195
  23.       Left            =   1035
  24.       TabIndex        =   1
  25.       Top             =   0
  26.       Width           =   690
  27.    End
  28.    Begin VB.Label lblCaption 
  29.       AutoSize        =   -1  'True
  30.       Caption         =   "lblCaption"
  31.       Height          =   195
  32.       Left            =   90
  33.       TabIndex        =   0
  34.       Top             =   0
  35.       Visible         =   0   'False
  36.       Width           =   690
  37.    End
  38.    Begin VB.Shape Flooder 
  39.       BorderStyle     =   0  'Transparent
  40.       FillColor       =   &H00808080&
  41.       FillStyle       =   0  'Solid
  42.       Height          =   330
  43.       Index           =   0
  44.       Left            =   1710
  45.       Top             =   0
  46.       Visible         =   0   'False
  47.       Width           =   1635
  48.    End
  49. End
  50. Attribute VB_Name = "axPanel"
  51. Attribute VB_GlobalNameSpace = False
  52. Attribute VB_Creatable = True
  53. Attribute VB_PredeclaredId = False
  54. Attribute VB_Exposed = True
  55. Const m_def_BorderStyle = 2
  56.  
  57. Private m_BorderStyle As Integer, iLast As Integer
  58. Private m_caption As String, m_text As String, m_TextAlignment As Integer
  59. Private m_TextType As Integer, m_FloodType As Integer, m_FloodPercent As Integer
  60. Private m_FloodShowPct As Boolean, m_FloodColor As Long, m_FloodBackColor As Long
  61. Private m_BackColor As Long, m_ForeColor As Long
  62.  
  63. Public Enum AxBorderStyles
  64.     [No Border] = 0
  65.     [Single] = 1
  66.     [Thin Raised] = 2
  67.     [Thick Raised] = 3
  68.     [Thin Inset] = 4
  69.     [Thick Inset] = 5
  70.     [Etched] = 6
  71.     [Bump] = 7
  72. End Enum
  73.  
  74. Public Enum TextAlign
  75.   [LeftTop] = 0
  76.   [LeftMiddle] = 1
  77.   [LeftBottom] = 2
  78.   [CenterTop] = 3
  79.   [CenterMiddle] = 4
  80.   [CenterBottom] = 5
  81.   [RightTop] = 6
  82.   [RightMiddle] = 7
  83.   [RightBottom] = 8
  84. End Enum
  85.  
  86. Public Enum TextTypes
  87.   [User Defined] = 0
  88.   [Current Date] = 1
  89.   [Current Time] = 2
  90. End Enum
  91.  
  92. Public Enum FloodTypes
  93.   [None] = 0
  94.   [LeftToRight] = 1
  95.   [RightToLeft] = 2
  96.   [TopToBottom] = 3
  97.   [BottomToTop] = 4
  98.   [Windows95] = 5
  99. End Enum
  100.   
  101. Private Sub Timer_Timer()
  102.   lblText.Caption = Time
  103. End Sub
  104.  
  105. Private Sub UserControl_Initialize()
  106.   UserControl.Height = 600: UserControl.Width = 2700
  107. End Sub
  108.  
  109. Private Sub UserControl_InitProperties()
  110.     m_BorderStyle = m_def_BorderStyle
  111.     m_caption = ""
  112.     m_TextAlignment = 4: m_text = "axPanel": m_TextType = 0
  113.     lblText.Left = 5: lblText.Top = UserControl.Height / 2
  114.     m_FloodType = 0
  115.     m_FloodPercent = 0
  116.     m_FloodShowPct = False
  117.     m_FloodColor = vbHighlight
  118.     m_FloodBackColor = vbButtonFace
  119.     m_BackColor = vbButtonFace
  120.     m_ForeColor = vbButtonText
  121.     UserControl.BackColor = m_BackColor
  122.     lblCaption.BackColor = m_BackColor
  123.     lblCaption.ForeColor = m_ForeColor
  124.     lblText.ForeColor = m_ForeColor
  125. End Sub
  126.  
  127. 'Load property values from storage
  128. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  129.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  130.     m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  131.     m_caption = PropBag.ReadProperty("Caption", "")
  132.     Set Font = PropBag.ReadProperty("Font", Ambient.Font)
  133.     Set lblCaption.Font = Font
  134.     Set lblText.Font = Font
  135.     m_text = PropBag.ReadProperty("Text", "")
  136.     m_TextAlignment = PropBag.ReadProperty("TextAlignment", 0)
  137.     m_TextType = PropBag.ReadProperty("TextType", 0)
  138.     m_FloodShowPct = PropBag.ReadProperty("FloodShowPct", False)
  139.     m_FloodType = PropBag.ReadProperty("FloodType", 0)
  140.     m_FloodPercent = PropBag.ReadProperty("FloodPercent", 0)
  141.     m_FloodColor = PropBag.ReadProperty("FloodColor", vbHighlight)
  142.     m_FloodBackColor = PropBag.ReadProperty("FloodBackColor", vbButtonFace)
  143.     m_BackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
  144.     m_ForeColor = PropBag.ReadProperty("ForeColor", vbButtonText)
  145.     
  146.     UserControl.BackColor = m_BackColor
  147.     lblCaption.BackColor = m_BackColor
  148.     lblCaption.ForeColor = m_ForeColor
  149.     lblText.ForeColor = m_ForeColor
  150.     DisplayText
  151.     If m_FloodType > 0 And m_FloodType <> 5 Then Flooder(0).Visible = True: DrawFlood Else Flooder(0).Visible = False
  152.   If m_FloodType = 5 Then Flooder(0).Visible = True: ShowBars: DrawFlood
  153.   If m_caption > "" Then
  154.     'UserControl.Cls
  155.     'UserControl_Paint
  156.     lblCaption.Visible = True
  157.     lblCaption.Caption = " " + m_caption + " "
  158.     UserControl.Refresh
  159.   Else
  160.     lblCaption.Visible = False
  161.     UserControl.Refresh
  162.     'UserControl.Cls
  163.     'UserControl_Paint
  164.   End If
  165.     
  166. End Sub
  167.  
  168. Private Sub UserControl_Resize()
  169.   If UserControl.Width > 0 And UserControl.Height > 0 Then
  170.     DisplayText
  171.     If m_FloodType > 0 And m_FloodType <> 5 Then Flooder(0).Visible = True: DrawFlood Else Flooder(0).Visible = False
  172.     If m_FloodType = 5 Then
  173.          ResizeBars
  174.          DrawFlood
  175.          'UserControl.Width = Flooder(Flooder().Count - 1).Left + Flooder(Flooder().Count - 1).Width + 10
  176.     End If
  177.     
  178.   End If
  179.   'UserControl.Refresh
  180. End Sub
  181.  
  182. 'Write property values to storage
  183. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  184.  
  185.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  186.     Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
  187.     Call PropBag.WriteProperty("Caption", m_caption, "")
  188.     Call PropBag.WriteProperty("Font", Font, Ambient.Font)
  189.     Call PropBag.WriteProperty("Text", Text, "")
  190.     Call PropBag.WriteProperty("TextAlignment", m_TextAlignment, 0)
  191.     Call PropBag.WriteProperty("TextType", m_TextType, 0)
  192.     Call PropBag.WriteProperty("FloodShowPct", m_FloodShowPct, False)
  193.     Call PropBag.WriteProperty("FloodType", m_FloodType, 0)
  194.     Call PropBag.WriteProperty("FloodPercent", m_FloodPercent, 0)
  195.     Call PropBag.WriteProperty("FloodColor", m_FloodColor, vbHighlight)
  196.     Call PropBag.WriteProperty("FloodBackColor", m_FloodBackColor, vbButtonFace)
  197.     Call PropBag.WriteProperty("BackColor", m_BackColor, vbButtonFace)
  198.     Call PropBag.WriteProperty("ForeColor", m_ForeColor, vbButtonText)
  199.     
  200. End Sub
  201.  
  202. Private Sub UserControl_Paint()
  203.     Dim di As Long
  204.     Dim rc As RECT
  205.     
  206.     'draw outside border
  207.         
  208.     di = GetClientRect(UserControl.hwnd, rc)
  209.     If m_caption > "" Then
  210.       rc.Top = rc.Top + 5
  211.     End If
  212.     
  213.     Select Case m_BorderStyle
  214.         Case [No Border]
  215.         
  216.         Case [Single]
  217.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDOUTER, BF_RECT Or BF_MONO)
  218.         
  219.         Case [Thin Raised]
  220.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDINNER, BF_TOPLEFT)
  221.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDOUTER, BF_BOTTOMRIGHT)
  222.         
  223.         Case [Thick Raised]
  224.             di = DrawEdge(UserControl.hDC, rc, EDGE_RAISED, BF_TOPLEFT)
  225.             di = DrawEdge(UserControl.hDC, rc, EDGE_RAISED, BF_BOTTOMRIGHT)
  226.     
  227.         Case [Thin Inset]
  228.             di = DrawEdge(UserControl.hDC, rc, BDR_SUNKENINNER, BF_TOPLEFT)
  229.             di = DrawEdge(UserControl.hDC, rc, BDR_SUNKENOUTER, BF_BOTTOMRIGHT)
  230.         
  231.         Case [Thick Inset]
  232.             di = DrawEdge(UserControl.hDC, rc, EDGE_SUNKEN, BF_TOPLEFT)
  233.             di = DrawEdge(UserControl.hDC, rc, EDGE_SUNKEN, BF_BOTTOMRIGHT)
  234.         
  235.         Case [Etched]
  236.             di = DrawEdge(UserControl.hDC, rc, EDGE_ETCHED, BF_TOPLEFT)
  237.             di = DrawEdge(UserControl.hDC, rc, EDGE_ETCHED, BF_BOTTOMRIGHT)
  238.     
  239.         Case [Bump]
  240.             di = DrawEdge(UserControl.hDC, rc, EDGE_BUMP, BF_TOPLEFT)
  241.             di = DrawEdge(UserControl.hDC, rc, EDGE_BUMP, BF_BOTTOMRIGHT)
  242.             
  243.     End Select
  244.     
  245.     'If m_FloodType > 0 Then DrawFlood
  246.         
  247. End Sub
  248.  
  249. Public Property Get BorderStyle() As AxBorderStyles
  250. Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object"
  251.     BorderStyle = m_BorderStyle
  252. End Property
  253.  
  254. Public Property Let BorderStyle(ByVal New_BorderStyle As AxBorderStyles)
  255.     If Not (m_BorderStyle = New_BorderStyle) Then
  256.         m_BorderStyle = New_BorderStyle
  257.   If m_caption > "" Then
  258.     'UserControl.Cls
  259.     'UserControl_Paint
  260.     lblCaption.Visible = True
  261.     lblCaption.Caption = " " + m_caption + " "
  262.     UserControl.Refresh
  263.   Else
  264.     lblCaption.Visible = False
  265.     'UserControl.Cls
  266.     'UserControl_Paint
  267.     UserControl.Refresh
  268.   End If
  269.     End If
  270.     PropertyChanged "BorderStyle"
  271. End Property
  272.  
  273. Public Sub ShowAbout()
  274. Attribute ShowAbout.VB_Description = "Show the about box for the control"
  275. Attribute ShowAbout.VB_UserMemId = -552
  276.   frmAbout.Show vbModal
  277. End Sub
  278. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  279. 'MappingInfo=UserControl,UserControl,-1,Enabled
  280. Public Property Get Enabled() As Boolean
  281. Attribute Enabled.VB_Description = "Returns/sets a value that detemines whether an object can respond to user-generated events"
  282.     Enabled = UserControl.Enabled
  283. End Property
  284.  
  285. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  286.     UserControl.Enabled() = New_Enabled
  287.     PropertyChanged "Enabled"
  288. End Property
  289.  
  290. Public Property Get Caption() As String
  291. Attribute Caption.VB_Description = "Returns/sets the text displayed in an object's title bar"
  292.   Caption = m_caption
  293. End Property
  294.  
  295. Public Property Let Caption(ByVal vNewValue As String)
  296.   m_caption = vNewValue
  297.   If m_caption > "" Then
  298.     'UserControl.Cls
  299.     'UserControl_Paint
  300.     lblCaption.Visible = True
  301.     lblCaption.Caption = " " + m_caption + " "
  302.     UserControl.Refresh
  303.   Else
  304.     lblCaption.Visible = False
  305.     'UserControl.Cls
  306.     'UserControl_Paint
  307.     UserControl.Refresh
  308.   End If
  309.   PropertyChanged "Caption"
  310. End Property
  311.  
  312. Public Property Get Font() As Font
  313. Attribute Font.VB_Description = "Returns/sets the font to be used to display the caption and text for this control"
  314.     Set Font = UserControl.Font
  315. End Property
  316.  
  317. Public Property Set Font(ByVal New_Font As Font)
  318.     Set UserControl.Font = New_Font
  319.     Set lblCaption.Font = New_Font
  320.     Set lblText.Font = New_Font
  321.     PropertyChanged "Font"
  322. End Property
  323.  
  324.  
  325. Public Property Get Text() As String
  326. Attribute Text.VB_Description = "Returns/sets the text displayed within the inner bevel of the panel if panel is not used as a progress indicator"
  327.   Text = m_text
  328. End Property
  329.  
  330. Public Property Let Text(ByVal vNewValue As String)
  331.   m_text = vNewValue
  332.   DisplayText
  333.   PropertyChanged "Text"
  334. End Property
  335.  
  336. Public Property Get TextAlignment() As TextAlign
  337. Attribute TextAlignment.VB_Description = "Returns/sets the alignment of text in the panel"
  338.   TextAlignment = m_TextAlignment
  339. End Property
  340.  
  341. Public Property Let TextAlignment(ByVal vNewValue As TextAlign)
  342.     If Not (m_TextAlignment = vNewValue) Then
  343.         m_TextAlignment = vNewValue
  344.         DisplayText
  345.     End If
  346.     PropertyChanged "TextAlignment"
  347. End Property
  348.  
  349. Private Sub DisplayText()
  350.        Timer.Enabled = False
  351.        If m_FloodType > 0 Then
  352.        If m_FloodShowPct And m_FloodType <> 5 Then
  353.          lblText.Visible = True
  354.          lblText.Caption = Str(m_FloodPercent) + "%"
  355.          lblText.Top = (UserControl.Height / 2) - TextHeight("X") / 2
  356.          lblText.Width = TextWidth(Str(m_FloodPercent) + "%")
  357.          lblText.Left = (UserControl.Width / 2) - TextWidth("100%") / 2
  358.          lblText.Alignment = 2
  359.        Else
  360.          lblText.Visible = False
  361.        End If
  362.          Exit Sub
  363.        End If
  364.        lblText.Visible = False
  365.        lblText.Caption = m_text
  366.        If m_TextType = 1 Then lblText.Caption = Date
  367.        If m_TextType = 2 Then lblText.Caption = Time: Timer.Enabled = True
  368.        'If m_TextType = 2 And UserControl.Extender.Parent.Ambient.UserMode Then Timer.Enabled = True
  369.        
  370.        lblText.Width = UserControl.Width - 120
  371.        Select Case m_TextAlignment
  372.        Case 0       'lefttop
  373.          lblText.Left = 60: lblText.Top = 60
  374.          lblText.Alignment = 0
  375.        Case 1       'leftmiddle
  376.          lblText.Left = 60: lblText.Top = (UserControl.Height / 2) - TextHeight("X") / 2
  377.          lblText.Alignment = 0
  378.        Case 2       'leftbottom
  379.          lblText.Left = 60: lblText.Top = UserControl.Height - 60 - TextHeight("X")
  380.          lblText.Alignment = 0
  381.        Case 3       'centertop
  382.          lblText.Left = 60: lblText.Top = 60
  383.          lblText.Alignment = 2
  384.        Case 4       'centermiddle
  385.          lblText.Left = 60: lblText.Top = (UserControl.Height / 2) - TextHeight("X") / 2
  386.          lblText.Alignment = 2
  387.        Case 5       'centerbottom
  388.          lblText.Left = 60: lblText.Top = UserControl.Height - 60 - TextHeight("X")
  389.          lblText.Alignment = 2
  390.        Case 6       'righttop
  391.          lblText.Left = 60: lblText.Top = 60
  392.          lblText.Alignment = 1
  393.        Case 7       'rightmiddle
  394.          lblText.Left = 60: lblText.Top = (UserControl.Height / 2) - TextHeight("X") / 2
  395.          lblText.Alignment = 1
  396.        Case 8       'rightbottom
  397.          lblText.Left = 60: lblText.Top = UserControl.Height - 60 - TextHeight("X")
  398.          lblText.Alignment = 1
  399.        End Select
  400.        lblText.Visible = True
  401. End Sub
  402.  
  403. Private Sub DrawFlood()
  404.   Dim fWidth As Integer, fHeight As Integer
  405.   Dim StartLeft As Integer, ActiveBars As Integer
  406.   fWidth = (UserControl.Width - 80) * (m_FloodPercent / 100)
  407.   fHeight = (UserControl.Height - 80) * (m_FloodPercent / 100)
  408.   
  409.   Select Case m_FloodType
  410.   Case 1        'left to right
  411.     Flooder(0).FillColor = m_FloodColor
  412.     Flooder(0).Height = UserControl.Height - 80
  413.     Flooder(0).Width = fWidth
  414.     Flooder(0).Left = 40: Flooder(0).Top = 40
  415.   
  416.   Case 2        'right to left
  417.     Flooder(0).FillColor = m_FloodColor
  418.     Flooder(0).Height = UserControl.Height - 80
  419.     Flooder(0).Width = fWidth
  420.     Flooder(0).Left = 40 + UserControl.Width - 80 - fWidth: Flooder(0).Top = 40
  421.   
  422.   Case 3        'top to bottom
  423.     Flooder(0).FillColor = m_FloodColor
  424.     Flooder(0).Height = fHeight
  425.     Flooder(0).Width = UserControl.Width - 80
  426.     Flooder(0).Left = 40: Flooder(0).Top = 40
  427.   
  428.   Case 4        'bottom to top
  429.     Flooder(0).FillColor = m_FloodColor
  430.     Flooder(0).Height = fHeight
  431.     Flooder(0).Width = UserControl.Width - 80
  432.     Flooder(0).Left = 40: Flooder(0).Top = 40 + UserControl.Height - 80 - fHeight
  433.   
  434.   Case 5
  435.     ActiveBars = 20 * (m_FloodPercent / 100) - 1
  436.     For bar = 0 To 19
  437.       If bar <= ActiveBars Then
  438.         Flooder(bar).FillColor = m_FloodColor
  439.       Else
  440.         Flooder(bar).FillColor = m_FloodBackColor
  441.       End If
  442.     Next
  443.   End Select
  444. End Sub
  445.  
  446. Public Property Get TextType() As TextTypes
  447. Attribute TextType.VB_Description = "Returns/sets a value to determine if text displayed is user-defined, current date, or current time"
  448.   TextType = m_TextType
  449. End Property
  450.  
  451. Public Property Let TextType(ByVal vNewValue As TextTypes)
  452.     If Not (m_TextType = vNewValue) Then
  453.         m_TextType = vNewValue
  454.         DisplayText
  455.     End If
  456.     PropertyChanged "TextType"
  457. End Property
  458.  
  459.  
  460. Public Property Get FloodShowPct() As Boolean
  461. Attribute FloodShowPct.VB_Description = "Determines whether the current setting of the FloodPercent property is displayed when the panel is used as a progress indicator"
  462.   FloodShowPct = m_FloodShowPct
  463. End Property
  464.  
  465. Public Property Let FloodShowPct(ByVal vNewValue As Boolean)
  466.   m_FloodShowPct = vNewValue
  467.   If m_FloodType > 0 Then DisplayText
  468.   PropertyChanged "FloodShowPct"
  469. End Property
  470.  
  471. Public Property Get FloodType() As FloodTypes
  472. Attribute FloodType.VB_Description = "Determines if and how the panel is used as a progress indicator"
  473.   FloodType = m_FloodType
  474. End Property
  475.  
  476. Public Property Let FloodType(ByVal vNewValue As FloodTypes)
  477.   m_FloodType = vNewValue
  478.   DisplayText
  479.   RemoveBars
  480.   If m_FloodType > 0 And m_FloodType <> 5 Then Flooder(0).Visible = True: DrawFlood Else Flooder(0).Visible = False
  481.   If m_FloodType = 5 Then Flooder(0).Visible = True: ShowBars: DrawFlood
  482.   PropertyChanged "FloodType"
  483. End Property
  484.  
  485. Public Property Get FloodPercent() As Integer
  486. Attribute FloodPercent.VB_Description = "Returns/set the percentage of the painted area inside the panel's inner bevel when the panel is used as a progress indicator"
  487.   FloodPercent = m_FloodPercent
  488. End Property
  489.  
  490. Public Property Let FloodPercent(ByVal vNewValue As Integer)
  491.   If vNewValue < 0 Then vNewValue = 0
  492.   If vNewValue > 100 Then vNewValue = 100
  493.   m_FloodPercent = vNewValue
  494.   If m_FloodType > 0 Then DisplayText: DrawFlood
  495.   PropertyChanged "FloodPercent"
  496. End Property
  497.  
  498. Public Property Get FloodColor() As OLE_COLOR
  499. Attribute FloodColor.VB_Description = "Returns/sets the color used to paint the area inside the panel's inner bevel when control is used as a progress indicator"
  500.   FloodColor = m_FloodColor
  501. End Property
  502.  
  503. Public Property Let FloodColor(ByVal vNewValue As OLE_COLOR)
  504.   m_FloodColor = vNewValue
  505.   If m_FloodType > 0 Then DisplayText: DrawFlood
  506.   PropertyChanged "FloodColor"
  507. End Property
  508.  
  509. Public Property Get FloodBackColor() As OLE_COLOR
  510. Attribute FloodBackColor.VB_Description = "Returns/sets color of inactive bars in Win95 style progress bar (only)"
  511.   FloodBackColor = m_FloodBackColor
  512. End Property
  513.  
  514. Public Property Let FloodBackColor(ByVal vNewValue As OLE_COLOR)
  515.   m_FloodBackColor = vNewValue
  516.   If m_FloodType > 0 Then DisplayText: DrawFlood
  517.   PropertyChanged "FloodBackColor"
  518. End Property
  519.  
  520. Public Property Get BackColor() As OLE_COLOR
  521. Attribute BackColor.VB_Description = "Returns/sets the background color of the object"
  522.   BackColor = m_BackColor
  523. End Property
  524.  
  525. Public Property Let BackColor(ByVal vNewValue As OLE_COLOR)
  526.   m_BackColor = vNewValue
  527.   UserControl.BackColor = m_BackColor
  528.   lblCaption.BackColor = m_BackColor
  529.   UserControl.Refresh
  530.   PropertyChanged "BackColor"
  531. End Property
  532.  
  533. Public Property Get ForeColor() As OLE_COLOR
  534. Attribute ForeColor.VB_Description = "Returns/sets color of caption and text for the control"
  535.   ForeColor = m_ForeColor
  536. End Property
  537.  
  538. Public Property Let ForeColor(ByVal vNewValue As OLE_COLOR)
  539.   m_ForeColor = vNewValue
  540.   UserControl.ForeColor = m_ForeColor
  541.   lblCaption.ForeColor = m_ForeColor
  542.   lblText.ForeColor = m_ForeColor
  543.   UserControl.Refresh
  544.   PropertyChanged "ForeColor"
  545. End Property
  546.  
  547. Private Sub ShowBars()
  548. 'display windows95 style bars for meter
  549.     Dim fBar95 As Integer
  550.     
  551.     'change mode to pixels to get more even spacing
  552.     UserControl.ScaleMode = vbPixels
  553.     fBar95 = Int((UserControl.ScaleWidth - Int(80 / Screen.TwipsPerPixelX)) / 20)
  554.     UserControl.ScaleMode = vbTwips
  555.     'convert to twips
  556.     fBar95 = fBar95 * Screen.TwipsPerPixelX
  557.     
  558.     Flooder(0).Visible = False
  559.     Flooder(0).FillColor = m_FloodBackColor
  560.     Flooder(0).Height = UserControl.Height - 80
  561.     Flooder(0).Width = fBar95 - 20
  562.     Flooder(0).Left = 40: Flooder(0).Top = 40
  563.     For cnt = 1 To 19
  564.       Load Flooder(cnt)
  565.       Flooder(cnt).FillColor = m_FloodBackColor
  566.       Flooder(cnt).Height = UserControl.Height - 80
  567.       Flooder(cnt).Width = fBar95 - 20
  568.       Flooder(cnt).Left = 40 + (fBar95 * cnt): Flooder(cnt).Top = 40
  569.     Next
  570.     For cnt = 0 To 19
  571.       Flooder(cnt).Visible = True
  572.     Next
  573.     
  574. End Sub
  575.  
  576. Private Sub ResizeBars()
  577. 'resize windows95 style bars for meter when control is resized
  578.     Dim fWidth95 As Integer, fBar95 As Integer
  579.     'change mode to pixels to get more even spacing
  580.     UserControl.ScaleMode = vbPixels
  581.     fWidth95 = Int((UserControl.ScaleWidth - Int(80 / Screen.TwipsPerPixelX)) / 20)
  582.     fBar95 = Int((UserControl.ScaleWidth - Int(80 / Screen.TwipsPerPixelX)) / 20)
  583.     UserControl.ScaleMode = vbTwips
  584.     'convert to twips
  585.     fWidth95 = fWidth95 * Screen.TwipsPerPixelX
  586.     fBar95 = fBar95 * Screen.TwipsPerPixelX
  587.     
  588.     For cnt = 0 To 19
  589.       Flooder(cnt).Visible = False
  590.     Next
  591.     Flooder(0).Height = UserControl.Height - 80
  592.     Flooder(0).Width = fBar95 - 20
  593.     For cnt = 1 To 19
  594.       Flooder(cnt).Height = UserControl.Height - 80
  595.       Flooder(cnt).Width = fBar95 - 20
  596.       Flooder(cnt).Left = 40 + (fWidth95 * cnt): Flooder(cnt).Top = 40
  597.     Next
  598.     For cnt = 0 To 19
  599.       Flooder(cnt).Visible = True
  600.     Next
  601.  
  602. End Sub
  603.  
  604. Private Sub RemoveBars()
  605. 'remove windows95 style bars for meter
  606. If Flooder().Count > 1 Then
  607.   For cnt = 1 To Flooder().Count - 1
  608.     Unload Flooder(cnt)
  609.   Next
  610. End If
  611.  
  612. End Sub
  613.  
  614.  
  615.