ProgressBar con un PictureBox (aportando code para todos).

[goodbye]

Insertar un Picturebox y un Timer para este ejemplo, luego pegar el siguiente

Código [Seleccionar] Expandir

Option Explicit

Private Declare Function GetPixel Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long) As Long

Dim intpercent As Integer

Private Sub Form_Load()
intpercent = 1
Timer1.Interval = 100
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
If intpercent <= 100 Then
ProgBar Picture1, CLng(intpercent), vbWhite, vbBlue, vbBlack, True, 0
Else
Timer1.Enabled = False
End If
intpercent = intpercent + 1
End Sub

Private Function ProgBar(PicX As PictureBox, _
PercentIn As Long, _
Optional BGcolor As Long = vbWhite, _
Optional FGcolor As Long = vbBlue, _
Optional TextColor = vbBlack, _
Optional DisplayText As Boolean = True, _
Optional Style As Integer = 0) As Boolean

Dim OnePercent As Single
Dim PBarWidth As Long
Dim PBarHeight As Long
Dim T As Long
Dim I As Long
Dim Temp As Long
Static J As Long

On Error GoTo Err_Handler

If J > PercentIn Then PicX.Cls
If J > 0 And J = PercentIn Then Exit Function

With PicX
.AutoRedraw = True
.ScaleMode = 3
.BackColor = BGcolor
.ForeColor = FGcolor
End With

PBarWidth = PicX.Width / Screen.TwipsPerPixelX
PBarHeight = PicX.Height / Screen.TwipsPerPixelY
OnePercent = PBarWidth / 100

Select Case Style

Case 1 ' Barra Vertical

OnePercent = PBarHeight / 100

For T = PBarHeight - (OnePercent * PercentIn) To PBarHeight
PicX.Line (0, T)-(PBarWidth, T)
Next T

If DisplayText = True Then
PicX.CurrentX = PBarWidth / 2 - 10
PicX.CurrentY = PBarHeight / 2 - 8
PicX.ForeColor = TextColor
PicX.Print "" & PercentIn & "%"

For T = PBarHeight - (OnePercent * PercentIn) To PBarHeight
For I = 0 To PBarWidth
If GetPixel(PicX.hdc, I, T) = TextColor _
Then PicX.PSet (I, T), BGcolor
Next I
If T > OnePercent * 60 Then T = PBarHeight
Next T
End If

For T = 0 To OnePercent * (PercentIn - 1)
PicX.Line (T, 0)-(T, PBarHeight)
Next T

For T = 0 To OnePercent * (PercentIn - 1) Step (OnePercent * 7)
PicX.ForeColor = BGcolor
PicX.Line (0, 0)-(PBarWidth - 1, 0)
PicX.Line (1, 1)-(1, PBarHeight - 1)
PicX.Line (PBarWidth - 1, 0)-(PBarWidth - 1, PBarHeight - 1)
PicX.Line (1, PBarHeight - 1)-(PBarWidth, PBarHeight - 1)
PicX.Line (1, PBarHeight - 2)-(PBarWidth, PBarHeight - 2)
PicX.Line (1, PBarHeight - 3)-(PBarWidth, PBarHeight - 3)

PicX.Line (T - 1, 0)-(T - 1, PBarHeight)
PicX.Line (T, 0)-(T, PBarHeight)
PicX.ForeColor = FGcolor
Next T

Case 3

Dim iRed As Integer, iBlue As Integer, iGreen As Integer
Dim nRed As Integer, nBlue As Integer, nGreen As Integer
Dim BlueRange As Long, RedRange As Long, GreenRange As Long
Dim RedPcnt As Single, GreenPcnt As Single, BluePcnt As Single
Dim Red1 As Long, Green1 As Long, Blue1 As Long
Dim rTemp As Long, bTemp As Long, gTemp As Long

Call ColorCodeToRGB(FGcolor, iRed, iGreen, iBlue)
nRed = iBlue: nBlue = iRed: nGreen = 128

RedRange = nRed - iRed
BlueRange = nBlue - iBlue
GreenRange = nGreen - iGreen

RedPcnt = RedRange / 100
GreenPcnt = GreenRange / 100
BluePcnt = BlueRange / 100

For T = 0 To OnePercent * (PercentIn - 1)

Red1 = nRed - RedPcnt * (T / OnePercent + 1)
If Red1 < 0 Then Red1 = 0

Green1 = nGreen - GreenPcnt * (T / OnePercent + 1)
If Green1 < 0 Then Green1 = 0

Blue1 = nBlue - BluePcnt * (T / OnePercent + 1)
If Blue1 < 0 Then Blue1 = 0

PicX.ForeColor = RGB(Red1, Green1, Blue1)
PicX.Line (T, 0)-(T, PBarHeight)
Next T

Case Else
For T = 0 To OnePercent * (PercentIn - 1)
PicX.Line (T, 0)-(T, PBarHeight)
Next T
End Select

If DisplayText = True Then

If Style <> 1 Then
PicX.CurrentX = PBarWidth / 2 - 7
PicX.CurrentY = PBarHeight / 2 - 8
PicX.ForeColor = TextColor
PicX.Print "" & PercentIn & "%"

If PercentIn > 40 Then
For T = OnePercent * 40 To OnePercent * (PercentIn - 1)
For I = 0 To PBarHeight
If GetPixel(PicX.hdc, T, I) = TextColor Then
PicX.PSet (T, I), PicX.BackColor
End If
Next I
If T > OnePercent * 60 Then T = _
OnePercent * (PercentIn - 1)
Next T
End If
End If

End If

J = PercentIn

ProgBar = True: Exit Function

Err_Handler:

ProgBar = False

End Function

Private Function ColorCodeToRGB(lColorCode As Long, _
iRed As Integer, _
iGreen As Integer, _
iBlue As Integer) As Boolean
Dim lColor As Long
lColor = lColorCode 'work long
iRed = lColor Mod &H100 'get red component
lColor = lColor \ &H100 'divide
iGreen = lColor Mod &H100 'get green component
lColor = lColor \ &H100 'divide
iBlue = lColor Mod &H100 'get blue component
ColorCodeToRGB = True
End Function


[NYlOn]

no encuentro la forma de ir agregandole valores...

es solo un efecto grafico o sirve pa algo ???

xD

[Numeros]

Olvidate del timer..

Código [Seleccionar] Expandir

Const T = 100 'En base a un Total

Private Function Porciento(Cantidad As Long, Total As Long) As Integer
    Porciento = Cantidad / Total * 100
End Function

Private Sub Command1_Click()
    Static C As Long
    C = C + 1
    ProgBar Picture1, CLng(Porciento(C, T)), vbWhite, vbBlue, vbBlack, True, 0
End Sub

[NYlOn]

thx ^^
ahora lo pruebo Numerito xD

un abraz0


-------- EDIT --------

Observacion:
Cambiar este code por

Código [Seleccionar] Expandir


Private Sub Command1_Click()
    Static C As Long
    C = C + 1
    ProgBar Picture1, CLng(Porciento(C, T)), vbWhite, vbBlue, vbBlack, True, 0
End Sub

este otro, asi si llega a 100 no sigue sumando ^^

Código [Seleccionar] Expandir


Private Sub Command1_Click()
    Static C As Long
    If C < 100 Then
    C = C + 1
    End If
    ProgBar Picture1, CLng(Porciento(C, T)), vbBlue, vbRed, vbYellow, True, 0
End Sub



che gracias x el code
ta bastante bueno y me viene de 10 (yo que odio las progress del vb xD)

cya

[Numeros]

este otro, asi si llega a 100 no sigue sumando ^^

jaja - tienes razón se me fue ese detalle..
ahora ya tienes la idea de como se calcula un progreso. por eso te puse la funcion del porciento

Chau

[NYlOn]

UTIL ^^
thx

bye