Título: ProgressBar con un PictureBox (aportando code para todos).
Publicado por: goodbye en 14 Julio 2005, 09:38 am
Insertar un Picturebox y un Timer para este ejemplo, luego pegar el siguiente 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
Título: Re: ProgressBar con un PictureBox (aportando code para todos).
Publicado por: NYlOn en 21 Agosto 2005, 06:04 am
no encuentro la forma de ir agregandole valores...
es solo un efecto grafico o sirve pa algo ???
xD
Título: Re: ProgressBar con un PictureBox (aportando code para todos).
Publicado por: Numeros en 21 Agosto 2005, 09:41 am
Olvidate del timer.. 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
Título: Re: ProgressBar con un PictureBox (aportando code para todos).
Publicado por: NYlOn en 21 Agosto 2005, 19:31 pm
thx ^^ ahora lo pruebo Numerito xD un abraz0 ;) -------- EDIT -------- Observacion: Cambiar este code por 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 ^^ 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
Título: Re: ProgressBar con un PictureBox (aportando code para todos).
Publicado por: Numeros en 21 Agosto 2005, 22:19 pm
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
Título: Re: ProgressBar con un PictureBox (aportando code para todos).
Publicado por: NYlOn en 22 Agosto 2005, 02:04 am
UTIL ^^ thx ;D
bye
|