Option Explicit
 
Private mlMin               As Long
Private mlMax               As Long
Private mlValue             As Long
Private mlStep              As Long
Private mlLoaded            As Long
Private mlLastValue         As Long
 
Private mbWithLabel         As Boolean
Private mbPLabelBold        As Boolean
 
Private mlWidth             As Long
Private mlHeight            As Long
 
Private Sub UserControl_InitProperties()
  mlMin = 0
  mlMax = 1
  mlValue = 0
  mlStep = 10
  mbWithLabel = False
End Sub
 
Private Sub UserControl_Initialize()
  mlLoaded = 0
  mlLastValue = 0
End Sub
 
Private Sub UserControl_Resize()
 
  mlWidth = 300
  mlStep = UserControl.ScaleWidth / mlWidth + 1
  mlHeight = UserControl.ScaleHeight - 10
  lblProzent.Left = (UserControl.ScaleWidth / 2) - lblProzent.Width / 2
  lblProzent.Top = (UserControl.ScaleHeight / 2) - lblProzent.Height / 2
 
  lblProgress(0).Left = 0
  lblProgress(0).Top = 0
  lblProgress(0).Height = UserControl.Height
  lblProgress(0).Width = UserControl.Width
  lblProgress(0).Visible = False
End Sub
 
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  mlMin = PropBag.ReadProperty("Min", mlMin)
  mlMax = PropBag.ReadProperty("Max", mlMax)
  mlValue = PropBag.ReadProperty("Value", mlValue)
  Me.ShowPLabel = PropBag.ReadProperty("ShowPLabel", mbWithLabel)
  Me.PLabelBold = PropBag.ReadProperty("PLabelBold", mbPLabelBold)
  Call UserControl_Resize
End Sub
 
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "Min", mlMin, 0
  PropBag.WriteProperty "Max", mlMax, 1
  PropBag.WriteProperty "Value", mlValue, 0
  PropBag.WriteProperty "ShowPLabel", mbWithLabel, False
  PropBag.WriteProperty "PLabelBold", mbPLabelBold, False
End Sub
 
Public Property Get Min() As Long
  Min = mlMin
End Property
Public Property Let Min(lNew As Long)
  If lNew >= 0 And lNew < mlMax Then
    mlMin = lNew
  End If
End Property
 
Public Property Get Max() As Long
  Max = mlMax
End Property
Public Property Let Max(lNew As Long)
  If lNew > 0 And lNew > mlMin Then
    mlMax = lNew
  Else
    mlMax = mlMin + 1
  End If
  mlValue = 0
  Call UserControl_Resize
End Property
 
Public Property Get Value() As Long
  Value = mlValue
End Property
Public Property Let Value(lNew As Long)
  If lNew >= mlMin And lNew <= mlMax Then
    mlValue = lNew
    Call DisplayStb
  End If
End Property
 
Public Property Get ShowPLabel() As Boolean
  ShowPLabel = mbWithLabel
End Property
Public Property Let ShowPLabel(bNew As Boolean)
  mbWithLabel = bNew
  lblProzent.Visible = mbWithLabel
End Property
 
Public Property Get PLabelBold() As Boolean
  PLabelBold = mbPLabelBold
End Property
Public Property Let PLabelBold(bNew As Boolean)
  mbPLabelBold = bNew
  lblProzent.Font.Bold = mbPLabelBold
End Property
 
Private Function DisplayStb()
  Dim bLoad         As Boolean
  Dim lUpTo         As Long
  Dim lCount        As Long
  Dim lPos          As Long
  ' Den Fortschritt anzeigen
  bLoad = False
  lPos = mlValue / mlMax * 100
  If mbWithLabel Then lblProzent.Caption = lPos & " %"
  lPos = lPos / (mlMax / mlStep)
  If lPos = mlLastValue Then Exit Function
  mlLastValue = lPos
  If lPos > mlLoaded Then
    ' Das betreffende Label ist noch nicht geladen
    lUpTo = lPos
  Else
    ' Das betreffende Label ist bereits geladen
    lUpTo = mlLoaded
  End If
 
  For lCount = 1 To lUpTo
    ' Laden des nächsten Labels
    If lblProgress.Count < lCount + 1 Then
      ' Label muss geladen werden
      Load lblProgress(lCount)
      mlLoaded = lCount
    End If
    With lblProgress(lCount)
      .Left = IIf(lCount = 1, 0, ((lCount - 1) * mlWidth))
      .Top = 5
      .Height = mlHeight
      .Width = mlWidth
      ' Die Farbe des Balkens
      .BackColor = &HFF8080
    End With
    If lCount <= lPos Then
      lblProgress(lCount).Visible = True
    Else
      ' Alle Labels, die größer als das aktuelle Value sind
      ' ausblenden
      For lPos = lCount To lblProgress.Count - 1
        If Not lblProgress(lPos).Visible Then Exit For
        lblProgress(lPos).Visible = False
      Next lPos
      Exit For
    End If
  Next lCount
End Function