Option Explicit
 
Const imax As Integer = 5
Dim iWert As Integer
 
Public Sub ProgressPaint(ByVal iValue As Integer)
 
Dim i As Long
Dim pWidth As Long
Dim intProz As Integer
Dim strProz As String
 
Const progBackColor = &HC00000
Const progForeColor = vbBlack
Const progForeColorHighlight = vbWhite
 
For i = 0 To iValue
Dim id As Long
  With Picture1
    ' Prüfen, ob AutoReadraw=True
    If .AutoRedraw = False Then .AutoRedraw = True
    ' Inhalt löschen
    .Cls
    ' Prozentwert ausrechnen
    If imax > 0 Then
        intProz = Int((i + 1) / imax * 100 + 0.5)
    Else
        intProz = 100
    End If
    If i + 1 > 0 Then
 
      ' Balkenbreite
      pWidth = .ScaleWidth / 100 * intProz
 
      ' Balken anzeigen
       Picture1.Line (0, 0)-(pWidth, .ScaleHeight), progBackColor, BF
 
      ' Prozentanzeige
        strProz = CStr(intProz) & " %"
        .CurrentX = (.ScaleWidth - .TextWidth(strProz)) / 2
        .CurrentY = (.ScaleHeight - .TextHeight(strProz)) / 2
 
        ' Vordergrundfarbe
        If pWidth >= .CurrentX Then
          .ForeColor = progForeColorHighlight
        Else
          .ForeColor = progForeColor
        End If
 
        Picture1.Print strProz
      End If
  End With
Next
End Sub
 
Private Sub Timer1_Timer()
 
 If iWert = imax Then
    Timer1.Enabled = False
 Else
    ProgressPaint iWert
     iWert = iWert + 1
 End If
End Sub

Gru?

Ralf