FAQ's de VB6

[Jad-Neo]

Este código sirve para simular una ProgressBar al estilo Windows 95 en un control PictureBox. Espero les guste, ya que sólo con cambiar el ForeColor del PicBox cambian el color de la barra y su texto, también si ponen el Pic en Flat y a Fixed Single toma una apariencia bastante atractiva, cosa que el ProgressBar de los Common Controls no trae:

Código:

Sub SimPGB(pctBox As PictureBox, PercentValue As Single, Optional Caption, Optional Horizontal As Boolean = True)
    Dim strPercent As String
    Dim intX As Integer
    Dim intY As Integer
    Dim intWidth As Integer
    Dim intHeight As Integer
    Dim intPercent As Single
    On Error GoTo ErLg

    If pctBox Is Nothing Then Error 5

    pctBox.AutoRedraw = True
    pctBox.BackColor = vbWhite

    intPercent = Int(100 * PercentValue + 0.5)

    If PercentValue < 0 Or PercentValue > 1# Then Error 5

    If IsMissing(Caption) = True Then
        strPercent = Format$(intPercent) & "%"
        intWidth = pctBox.TextWidth(strPercent)
        intHeight = pctBox.TextHeight(strPercent)
    Else
        intWidth = pctBox.TextWidth(Caption)
        intHeight = pctBox.TextHeight(Caption)
    End If

    intX = pctBox.Width / 2 - intWidth / 2
    intY = pctBox.Height / 2 - intHeight / 2

    pctBox.DrawMode = 13
    pctBox.Line (intX, intY)-(intWidth, intHeight), pctBox.BackColor, BF

    pctBox.CurrentX = intX
    pctBox.CurrentY = intY

    If IsMissing(Caption) = True Then
        pctBox.Print strPercent
    Else
        pctBox.Print Caption
    End If

    pctBox.DrawMode = 10

    If Horizontal = True Then
        If PercentValue > 0 Then
            pctBox.Line (0, 0)-(pctBox.Width * PercentValue, pctBox.Height), pctBox.ForeColor, BF
        Else
            pctBox.Line (0, 0)-(pctBox.Width, pctBox.Height), pctBox.BackColor, BF
        End If
    Else
        If PercentValue > 0 Then
            pctBox.Line (0, pctBox.Height)-(pctBox.Width, pctBox.Height - (pctBox.Height * PercentValue)), pctBox.ForeColor, BF
        Else
            pctBox.Line (0, pctBox.Height)-(pctBox.Width, pctBox.Height), pctBox.BackColor, BF
        End If
    End If
    
Exit Sub
ErLg: Error Err.Number
End Sub

Bye y ojala les guste.