picprogressbar.cls

网上收集的一个考试管理系统。带论文的

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "PicProgressBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Private PicPBar As PictureBox
Private Max As Long
Private Min As Long
Private Value As Long
Private PValue As Long
Private M As Double
Private P As Integer
Private PColor As Long
Private txtColor As Long
Private Direction As Integer
Public Sub SetPic(PictureBar As PictureBox)
    Set PicPBar = PictureBar
    PValue = 0
    PicPBar.AutoRedraw = True
 
End Sub

Public Property Get picBarMax() As Long
picBarMax = Max
End Property

Public Property Let picBarMax(ByVal BarMax As Long)
Max = BarMax
M = PicPBar.Width / Max
End Property


Public Property Get picBarMin() As Long
picBarMin = Min
End Property

Public Property Let picBarMin(ByVal BarMin As Long)
Min = BarMin
End Property



Public Property Get picBarColor() As Long
picBarColor = PColor
End Property

Public Property Let picBarColor(ByVal BarColor As Long)
PColor = BarColor
End Property

Public Property Get picTextColor() As Long
picTextColor = txtColor
End Property

Public Property Let picTextColor(ByVal BartxtColor As Long)
txtColor = BartxtColor
PicPBar.ForeColor = txtColor
End Property


Public Property Get picBarValue() As Long
picBarValue = Value
End Property

Public Property Let picBarValue(ByVal BarValue As Long)
Value = BarValue
Call SetValue(Value)
End Property

Public Property Get picBarDirection() As Integer
picBarDirection = Direction
End Property

Public Property Let picBarDirection(ByVal BarDirection As Integer)
Direction = BarDirection
Select Case Direction
       Case 0, 1
            M = PicPBar.Width / Max
       Case 2, 3
            M = PicPBar.Height / Max
       Case 4
            M = Sqr((PicPBar.Width / 2) * (PicPBar.Width / 2) + PicPBar.Height * PicPBar.Height) / Max
     
End Select
End Property

Private Sub SetValue(ByVal pBarValue As Long)
Dim i As Double
Dim b As Integer
'For i = M * PValue To M * pBarValue
P = (pBarValue / Max) * 100

PicPBar.Cls

Select Case Direction
       Case 0
            
            'For i = 0 To M * pBarValue
           
             PicPBar.Line (0, 0)-(M * pBarValue, PicPBar.Height), PColor, BF
            'Next i
            If P > 100 Then: P = 100
            PicPBar.CurrentX = PicPBar.ScaleWidth / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.CurrentY = PicPBar.ScaleHeight / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.Print P & "%"
            'PicPBar.PValue = pBarValue
       Case 1
            'For i = PicPBar.Width To M * (Max - pBarValue) Step -1
            'DoEvents
             PicPBar.Line (PicPBar.Width, 0)-(M * (Max - pBarValue), PicPBar.Height), PColor, BF
            'Next i
            If P > 100 Then: P = 100
            PicPBar.CurrentX = PicPBar.ScaleWidth / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.CurrentY = PicPBar.ScaleHeight / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.Print P & "%"
            'PicPBar.PValue = pBarValue

       Case 2
       
            For i = 0 To M * pBarValue
            'DoEvents
             PicPBar.Line (0, i)-(PicPBar.Width, i), PColor
            Next i
            If P > 100 Then: P = 100
            PicPBar.CurrentX = PicPBar.ScaleWidth / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.CurrentY = PicPBar.ScaleHeight / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.Print P & "%"
            'PicPBar.PValue = pBarValue
       Case 3
            For i = PicPBar.Height To M * (Max - pBarValue) Step -1
            'DoEvents
             PicPBar.Line (0, i)-(PicPBar.Width, i), PColor
            Next i
            If P > 100 Then: P = 100
            PicPBar.CurrentX = PicPBar.ScaleWidth / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.CurrentY = PicPBar.ScaleHeight / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.Print P & "%"
            'PicPBar.PValue = pBarValue
       Case 4
            For i = 0 To M * pBarValue
            PicPBar.Circle (PicPBar.ScaleWidth / 2, PicPBar.ScaleHeight / 2), i, PColor, 1, 1
            Next i
            If P > 100 Then: P = 100
            PicPBar.CurrentX = PicPBar.ScaleWidth / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.CurrentY = PicPBar.ScaleHeight / 2 - PicPBar.TextHeight(P & "%") / 2
            PicPBar.Print P & "%"

End Select
End Sub