VERSION 5.00
Begin VB.UserControl RaisedMeter 
   AutoRedraw      =   -1  'True
   ClientHeight    =   3405
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1755
   EditAtDesignTime=   -1  'True
   PaletteMode     =   0  'Halftone
   ScaleHeight     =   227
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   117
   Begin VB.Line lneTubeLeft 
      X1              =   0
      X2              =   0
      Y1              =   21
      Y2              =   208
   End
   Begin VB.Shape shpTubeTop 
      Height          =   600
      Left            =   0
      Shape           =   2  'Oval
      Top             =   0
      Width           =   1725
   End
   Begin VB.Shape shpTubeValue 
      BorderColor     =   &H00000000&
      FillColor       =   &H00FFC0C0&
      FillStyle       =   0  'Solid
      Height          =   600
      Left            =   0
      Shape           =   2  'Oval
      Top             =   450
      Width           =   1725
   End
   Begin VB.Shape shpTubeFill 
      BorderStyle     =   0  'Transparent
      FillColor       =   &H00FFC0C0&
      FillStyle       =   0  'Solid
      Height          =   2355
      Left            =   15
      Top             =   765
      Width           =   1710
   End
   Begin VB.Line lneTubeRight 
      X1              =   114
      X2              =   114
      Y1              =   18
      Y2              =   205
   End
   Begin VB.Shape shpTubeBottom 
      FillColor       =   &H00FFC0C0&
      FillStyle       =   0  'Solid
      Height          =   600
      Left            =   0
      Shape           =   2  'Oval
      Top             =   2790
      Width           =   1725
   End
End
Attribute VB_Name = "RaisedMeter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'Default Property Values:
Const m_def_BackColor = &H909090
Const m_def_FontColor = 0
Const m_def_TopColor = &HFFFFFF
Const m_def_FrontColor = &HB0B0B0
Const m_def_BorderColor = &H0
Const m_def_MinValue = 0
Const m_def_MaxValue = 1
Const m_def_Value = 0

'Property Variables:
Dim m_BackColor As OLE_COLOR
Dim m_Font As Font
Dim m_FontColor As OLE_COLOR
Dim m_TopColor As OLE_COLOR
Dim m_FrontColor As OLE_COLOR
Dim m_BorderColor As OLE_COLOR
Dim m_MinValue As Currency
Dim m_MaxValue As Currency
Dim m_Value As Currency
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&H909090
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
m_BackColor = New_BackColor
PropertyChanged "BackColor"
Call DrawMeter
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BorderStyle
Public Property Get BorderStyle() As Integer
Attribute BorderStyle.VB_Description = "Returns/sets the border style for an object."
BorderStyle = UserControl.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
UserControl.BorderStyle() = New_BorderStyle
PropertyChanged "BorderStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,DrawMode
Public Property Get DrawMode() As Integer
Attribute DrawMode.VB_Description = "Sets the appearance of output from graphics methods or of a Shape or Line control."
DrawMode = UserControl.DrawMode
End Property

Public Property Let DrawMode(ByVal New_DrawMode As Integer)
UserControl.DrawMode() = New_DrawMode
PropertyChanged "DrawMode"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=6,0,0,0
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
Set Font = m_Font
End Property

Public Property Set Font(ByVal New_Font As Font)
Set m_Font = New_Font
PropertyChanged "Font"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hDC
Public Property Get hDC() As Long
Attribute hDC.VB_Description = "Returns a handle (from Microsoft Windows) to the object's device context."
hDC = UserControl.hDC
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,HasDC
Public Property Get HasDC() As Boolean
Attribute HasDC.VB_Description = "Determines whether a unique display context is allocated for the control."
HasDC = UserControl.HasDC
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,hWnd
Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
hWnd = UserControl.hWnd
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get FontColor() As OLE_COLOR
FontColor = m_FontColor
End Property

Public Property Let FontColor(ByVal New_FontColor As OLE_COLOR)
m_FontColor = New_FontColor
PropertyChanged "FontColor"
Call DrawMeter
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&HFFFFFF
Public Property Get TopColor() As OLE_COLOR
TopColor = m_TopColor
End Property

Public Property Let TopColor(ByVal New_TopColor As OLE_COLOR)
m_TopColor = New_TopColor
PropertyChanged "TopColor"
Call DrawMeter
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&HB0B0B0
Public Property Get FrontColor() As OLE_COLOR
FrontColor = m_FrontColor
End Property

Public Property Let FrontColor(ByVal New_FrontColor As OLE_COLOR)
m_FrontColor = New_FrontColor
PropertyChanged "FrontColor"
Call DrawMeter
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,&H000000
Public Property Get BorderColor() As OLE_COLOR
BorderColor = m_BorderColor
End Property

Public Property Let BorderColor(ByVal New_BorderColor As OLE_COLOR)
m_BorderColor = New_BorderColor
PropertyChanged "BorderColor"
Call DrawMeter
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=2,0,0,0
Public Property Get MinValue() As Currency
MinValue = m_MinValue
End Property

Public Property Let MinValue(ByVal New_MinValue As Currency)
If New_MinValue > m_MaxValue Then New_MinValue = m_MaxValue - 1
If New_MinValue < 0 Then New_MinValue = 0

m_MinValue = New_MinValue
PropertyChanged "MinValue"
Call DrawValue
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=2,0,0,0
Public Property Get MaxValue() As Currency
MaxValue = m_MaxValue
End Property

Public Property Let MaxValue(ByVal New_MaxValue As Currency)

If New_MaxValue < m_MinValue Then New_MaxValue = m_MinValue + 1
If New_MaxValue < 1 Then New_MaxValue = 1

m_MaxValue = New_MaxValue
PropertyChanged "MaxValue"
Call DrawValue
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=2,0,0,0
Public Property Get Value() As Currency
Value = m_Value
End Property

Public Property Let Value(ByVal New_Value As Currency)

If New_Value < m_MinValue Then New_Value = m_MinValue
If New_Value > m_MaxValue Then New_Value = m_MaxValue

m_Value = New_Value
PropertyChanged "Value"
Call DrawValue
End Property

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_BackColor = m_def_BackColor
Set m_Font = Ambient.Font
m_FontColor = m_def_FontColor
m_TopColor = m_def_TopColor
m_FrontColor = m_def_FrontColor
m_BorderColor = m_def_BorderColor
m_MinValue = m_def_MinValue
m_MaxValue = m_def_MaxValue
m_Value = m_def_Value
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

m_BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
UserControl.DrawMode = PropBag.ReadProperty("DrawMode", 13)
Set m_Font = PropBag.ReadProperty("Font", Ambient.Font)
m_FontColor = PropBag.ReadProperty("FontColor", m_def_FontColor)
m_TopColor = PropBag.ReadProperty("TopColor", m_def_TopColor)
m_FrontColor = PropBag.ReadProperty("FrontColor", m_def_FrontColor)
m_BorderColor = PropBag.ReadProperty("BorderColor", m_def_BorderColor)
m_MinValue = PropBag.ReadProperty("MinValue", m_def_MinValue)
m_MaxValue = PropBag.ReadProperty("MaxValue", m_def_MaxValue)
m_Value = PropBag.ReadProperty("Value", m_def_Value)
End Sub
Private Sub UserControl_Resize()
Call DrawMeter
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
Call PropBag.WriteProperty("DrawMode", UserControl.DrawMode, 13)
Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
Call PropBag.WriteProperty("FontColor", m_FontColor, m_def_FontColor)
Call PropBag.WriteProperty("TopColor", m_TopColor, m_def_TopColor)
Call PropBag.WriteProperty("FrontColor", m_FrontColor, m_def_FrontColor)
Call PropBag.WriteProperty("BorderColor", m_BorderColor, m_def_BorderColor)
Call PropBag.WriteProperty("MinValue", m_MinValue, m_def_MinValue)
Call PropBag.WriteProperty("MaxValue", m_MaxValue, m_def_MaxValue)
Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
End Sub
Sub DrawMeter()

Dim uMainIndex As Long

    With UserControl
    uMainIndex = Int(Int(.ScaleWidth / 2) / 2) * 2
    
    .shpTubeTop.Left = 0
    .shpTubeTop.Top = 0
    .shpTubeTop.Width = uMainIndex * 2
    .shpTubeTop.Height = uMainIndex
    .shpTubeTop.BorderColor = m_BorderColor
    
    .shpTubeBottom.Left = 0
    .shpTubeBottom.Top = .ScaleHeight - uMainIndex
    .shpTubeBottom.Width = uMainIndex * 2
    .shpTubeBottom.Height = uMainIndex
    .shpTubeBottom.BorderColor = m_BackColor
    .shpTubeBottom.FillColor = m_FrontColor
    
    .shpTubeValue.Left = 0
    .shpTubeValue.Width = uMainIndex * 2
    .shpTubeValue.Height = uMainIndex
    .shpTubeValue.BorderColor = m_BorderColor
    .shpTubeValue.FillColor = m_TopColor
    
    .lneTubeLeft.X1 = 0
    .lneTubeLeft.X2 = 0
    .lneTubeLeft.Y1 = uMainIndex / 2
    .lneTubeLeft.Y2 = .ScaleHeight - (uMainIndex / 2)
    .lneTubeLeft.BorderColor = m_BorderColor
    
    .lneTubeRight.X1 = uMainIndex * 2 - 1
    .lneTubeRight.X2 = uMainIndex * 2 - 1
    .lneTubeRight.Y1 = uMainIndex / 2
    .lneTubeRight.Y2 = .ScaleHeight - (uMainIndex / 2)
    .lneTubeRight.BorderColor = m_BackColor
    
    .shpTubeFill.Left = 1
    .shpTubeFill.Width = uMainIndex * 2 - 1
    .shpTubeFill.FillColor = m_FrontColor
    
    End With

Call DrawValue

End Sub

Sub DrawValue()
Dim uMainIndex As Long, uPos As Long

    With UserControl
    uMainIndex = Int(Int(.ScaleWidth / 2) / 2) * 2
    
    .shpTubeBottom.FillStyle = (m_Value = m_MinValue) * -1
    .shpTubeValue.FillStyle = (m_Value = m_MinValue) * -1
    .shpTubeFill.Visible = Not (m_Value = m_MinValue)
    
    uMainIndex = Int(Int(.ScaleWidth / 2) / 2) * 2
    
    uPos = (.ScaleHeight - uMainIndex) * (1 - (m_Value / m_MaxValue))
    
    .shpTubeValue.Top = uPos
    .shpTubeFill.Top = uPos + uMainIndex / 2
    .shpTubeFill.Height = .shpTubeBottom.Top - .shpTubeValue.Top
    End With

End Sub
