Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/status_1/statusba.ctl

Text File | 1999-07-15 | 11.3 KB | 411 lines

VERSION 5.00
Begin VB.UserControl StatusBar
   Appearance      =   0  'Flat
   AutoRedraw      =   -1  'True
   BorderStyle     =   1  'Fixed Single
   CanGetFocus     =   0   'False
   ClientHeight    =   390
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1965
   ClipControls    =   0   'False
   ScaleHeight     =   26
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   131
   ToolboxBitmap   =   "StatusBar.ctx":0000
End
Attribute VB_Name = "StatusBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Const GRAY = &HC0C0C0

Enum BackStyleOpt
    Opaque = 0
    Transparent = 1
End Enum

Enum BorderStyleOpt
    None = 0
    Fixed = 1
End Enum

Enum Direction
    Horizontal = 0
    Vertical = 1
End Enum

Enum ABoolean
    No
    Yes
End Enum

Enum Widths
    Thin = 1
    Thick = 3
End Enum

Dim DispSpace As Integer
Dim DispLen As Long
Dim DispVisible As Boolean
Dim DispFillColor As Long
Dim DispBorderColor As Long
Dim DispSweep As Direction
Dim DispBorderStyle As BorderStyleOpt
Dim DispBackStyle As BackStyleOpt
Dim DispBorderWidth As Widths

Dim ShwGraph As Boolean
Dim GphColor As Long
Dim GphSpace As Integer
Dim GphLnWidth As Widths
Dim GphLnStyle As BorderStyleConstants

Dim DispX1 As Double
Dim DispX2 As Double
Dim DispY1 As Double
Dim DispY2 As Double

Dim Max As Double
Dim Min As Double
Dim Val As Double
Dim Perc As Double

Event Click()
Event DblClick()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Property Get GraphLineStyle() As BorderStyleConstants
    GraphLineStyle = GphLnStyle
End Property

Property Let GraphLineStyle(NewStyle As BorderStyleConstants)
    GphLnStyle = NewStyle
    PropertyChanged "GraphLineStyle"
End Property

Property Get DisplayBorderWidth() As Widths
    DisplayBorderWidth = DispBorderWidth
End Property

Property Let DisplayBorderWidth(NewWidth As Widths)
    DispBorderWidth = NewWidth
    PropertyChanged "DisplayBorderWidth"
    PaintDisplay
End Property

Property Get GraphLineWidth() As Widths
    GraphLineWidth = GphLnWidth
End Property

Property Let GraphLineWidth(NewWidth As Widths)
    GphLnWidth = NewWidth
    PropertyChanged "GraphLineWidth"
    If ShwGraph Then PaintDisplay
End Property

Property Get GraphSpacing() As Integer
    GraphSpacing = GphSpace
End Property

Property Let GraphSpacing(NewValue As Integer)
    GphSpace = NewValue
    PropertyChanged "GraphSpacing"
    PaintDisplay
End Property

Property Get GraphColor() As OLE_COLOR
    GraphColor = GphColor
End Property

Property Let GraphColor(NewColor As OLE_COLOR)
    GphColor = NewColor
    PropertyChanged "GraphColor"
    PaintDisplay
End Property

Property Get ShowGraph() As Boolean
    ShowGraph = ShwGraph
End Property

Property Let ShowGraph(NewSetting As Boolean)
    ShwGraph = NewSetting
    PropertyChanged "ShowGraph"
    If ShwGraph = False Then UserControl_Resize
    If ShwGraph = True Then PaintGraph
End Property

Property Get DisplaySpace() As Integer
    DisplaySpace = DispSpace
End Property

Property Let DisplaySpace(NewValue As Integer)
    DispSpace = NewValue
    PropertyChanged "DisplaySpace"
    UserControl_Resize
End Property

Property Get Percent() As Double
    Percent = Perc
End Property

Property Let Percent(NewPercent As Double)
    If NewPercent > 100 Or NewPercent < 0 Then Exit Property
    Perc = NewPercent
    PropertyChanged "Percent"
    Val = Perc / 100 * (Max - Min)
    UserControl_Resize
End Property

Property Get Value() As Double
    Value = Val
End Property

Property Let Value(NewValue As Double)
    Val = NewValue
    PropertyChanged "Value"
    If Val > Max Then Val = Max
    If Val < Min Then Val = Min
    UserControl_Resize
End Property

Property Get Maximum() As Double
    Maximum = Max
End Property

Property Let Maximum(NewValue As Double)
    Max = NewValue
    PropertyChanged "Maximum"
    If Val > Max Then Val = Max
    UserControl_Resize
End Property

Property Get Minimum() As Double
    Minimum = Min
End Property

Property Let Minimum(NewValue As Double)
    Min = NewValue
    PropertyChanged "Minimum"
    If Val < Min Then Val = Min
    UserControl_Resize
End Property

Property Get BorderStyle() As BorderStyleOpt
    BorderStyle = UserControl.BorderStyle
End Property

Property Let BorderStyle(NewStyle As BorderStyleOpt)
    UserControl.BorderStyle = NewStyle
    PropertyChanged "BorderStyle"
End Property

Property Get DisplayBackStyle() As BackStyleOpt
    DisplayBackStyle = DispBackStyle
End Property

Property Let DisplayBackStyle(NewStyle As BackStyleOpt)
    DispBackStyle = NewStyle
    PropertyChanged "DisplayBackStyle"
    PaintDisplay
End Property

Property Get DisplaySweep() As Direction
    DisplaySweep = DispSweep
End Property

Property Let DisplaySweep(NewDirection As Direction)
    DispSweep = NewDirection
    PropertyChanged "DisplaySweep"
    UserControl_Resize
End Property

Property Get BackColor() As OLE_COLOR
    BackColor = UserControl.BackColor
End Property

Property Let BackColor(NewColor As OLE_COLOR)
    UserControl.BackColor = NewColor
    PropertyChanged "BackColor"
End Property

Property Get BorderColor() As OLE_COLOR
    BorderColor = DispBorderColor
End Property

Property Let BorderColor(NewColor As OLE_COLOR)
    DispBorderColor = NewColor
    PropertyChanged "BorderColor"
    PaintDisplay
End Property

Property Get FillColor() As OLE_COLOR
    FillColor = DispFillColor
End Property

Property Let FillColor(NewColor As OLE_COLOR)
    DispFillColor = NewColor
    PropertyChanged "FillColor"
    PaintDisplay
End Property

Property Get DisplayBorderStyle() As BorderStyleOpt
    DisplayBorderStyle = DispBorderStyle
End Property

Property Let DisplayBorderStyle(NewValue As BorderStyleOpt)
    DispBorderStyle = NewValue
    PropertyChanged "DisplayBorderStyle"
    PaintDisplay
End Property

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_InitProperties()
    DispFillColor = vbGreen
    DispBorderStyle = 1
    UserControl.BorderStyle = 1
    UserControl.BackColor = vbRed
    DispSpace = 2
    Max = 10000
    GphSpace = 5
    GphColor = GRAY
    ShwGraph = False
    GphLnWidth = Thin
    DispBorderWidth = Thin
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, ScaleX(X, ScaleMode, vbContainerPosition), ScaleY(Y, ScaleMode, vbContainerPosition))
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, ScaleX(X, ScaleMode, vbContainerPosition), ScaleY(Y, ScaleMode, vbContainerPosition))
End Sub

Private Sub UserControl_Paint()
    PaintDisplay
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    DispSpace = PropBag.ReadProperty("DisplaySpace", 2)
    Max = PropBag.ReadProperty("Maximum", 10000)
    Min = PropBag.ReadProperty("Minimum", 0)
    Val = PropBag.ReadProperty("Value", 0)
    DispBorderColor = PropBag.ReadProperty("BorderColor", 0)
    DispFillColor = PropBag.ReadProperty("FillColor", vbGreen)
    DispBackStyle = PropBag.ReadProperty("DisplayBackStyle", 0)
    DispBorderStyle = PropBag.ReadProperty("DisplayBorderStyle", 1)
    DispSweep = PropBag.ReadProperty("DisplaySweep", 0)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", vbRed)
    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
    DispBorderWidth = PropBag.ReadProperty("DisplayBorderWidth", 1)
    GphLnWidth = PropBag.ReadProperty("GraphLineWidth", 1)
    GphLnStyle = PropBag.ReadProperty("GraphLineStyle", 0)
    GphSpace = PropBag.ReadProperty("GraphSpacing", 5)
    GphColor = PropBag.ReadProperty("GraphColor", GRAY)
    ShwGraph = PropBag.ReadProperty("ShowGraph", False)
End Sub

Private Sub UserControl_Resize()
Dim SWidth As Double, SHeight As Double
    Cls
    GetPercent
    SWidth = UserControl.ScaleWidth
    SHeight = UserControl.ScaleHeight
    ExchangeData SWidth, SHeight
    DispX1 = DispSpace
    DispY1 = DispSpace
    DispLen = SWidth - DispSpace * 2 - 1
    DispX2 = (Perc / 100) * DispLen + DispX1
    DispY2 = SHeight - DispY1 - 1
    ExchangeData DispX1, DispY1
    ExchangeData DispX2, DispY2
    PaintDisplay
End Sub

Private Sub ExchangeData(ByRef Data1 As Variant, ByRef Data2 As Variant)
Dim TempData As Variant
    If DispSweep = Vertical Then
        TempData = Data1
        Data1 = Data2
        Data2 = TempData
    End If
End Sub

Private Sub PaintDisplay()
    Cls
    If Percent = 0 Then Exit Sub
    If DispBackStyle = Opaque Then
        UserControl.Line (DispX1, DispY1)-(DispX2, DispY2), DispFillColor, BF
    End If
    If ShwGraph Then PaintGraph
    UserControl.DrawStyle = 0
    If DispBorderWidth = 0 Then DispBorderWidth = Thin
    UserControl.DrawWidth = DispBorderWidth
    If DispBorderStyle = Fixed Then
        UserControl.Line (DispX1, DispY1)-(DispX2, DispY2), DispBorderColor, B
    End If
    DoEvents
End Sub

Private Sub GetPercent()
    If Max - Min = 0 Then
        Perc = 0
        Exit Sub
    End If
    Perc = (Val - Min) / (Max - Min) * 100
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    PropBag.WriteProperty "DisplaySpace", DispSpace, 2
    PropBag.WriteProperty "Maximum", Max, 10000
    PropBag.WriteProperty "Minimum", Min, 0
    PropBag.WriteProperty "Value", Val, 0
    PropBag.WriteProperty "BorderColor", DispBorderColor, 0
    PropBag.WriteProperty "FillColor", DispFillColor, vbGreen
    PropBag.WriteProperty "DisplayBackStyle", DispBackStyle, 0
    PropBag.WriteProperty "DisplayBorderStyle", DispBorderStyle, 1
    PropBag.WriteProperty "DisplaySweep", DispSweep, 0
    PropBag.WriteProperty "BackColor", UserControl.BackColor, vbRed
    PropBag.WriteProperty "BorderStyle", UserControl.BorderStyle, 1
    PropBag.WriteProperty "DisplayBorderWidth", DispBorderWidth, 1
    PropBag.WriteProperty "GraphLineWidth", GphLnWidth, 1
    PropBag.WriteProperty "GraphLineStyle", GphLnStyle, 0
    PropBag.WriteProperty "GraphSpacing", GphSpace, 5
    PropBag.WriteProperty "GraphColor", GphColor, GRAY
    PropBag.WriteProperty "ShowGraph", ShwGraph, False
End Sub

Private Sub PaintGraph()
Dim i As Integer
Dim LineLeft As Double, LineRight As Double
Dim LineTop As Double, LineBottom As Double
    If GphLnWidth = 0 Then GphLnWidth = Thin
    UserControl.DrawWidth = GphLnWidth
    UserControl.DrawStyle = GphLnStyle
    For i = 0 To Perc \ GphSpace
        LineLeft = DispLen * (i * GphSpace) / 100 + DispSpace
        LineRight = LineLeft
        LineTop = DispY1 + 1
        LineBottom = DispY2
        If DispSweep = Vertical Then
            ExchangeData LineLeft, LineTop
            ExchangeData LineRight, LineBottom
            LineLeft = DispX1 + 1
            LineRight = DispX2
        End If
        Line (LineLeft, LineTop)-(LineRight, LineBottom), GphColor
    Next i
End Sub