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:
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