elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Entrar al Canal Oficial Telegram de elhacker.net


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  ProgressBar con un PictureBox (aportando code para todos).
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: ProgressBar con un PictureBox (aportando code para todos).  (Leído 2,356 veces)
goodbye

Desconectado Desconectado

Mensajes: 93



Ver Perfil
ProgressBar con un PictureBox (aportando code para todos).
« en: 14 Julio 2005, 09:38 am »

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

Código:
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


« Última modificación: 14 Julio 2005, 10:09 am por CrackelDestripador » En línea

Al lado de la dificultad está la facilidad.
Cambiad de placeres, pero no cambies de amigos.
Aceptar un favor de un amigo, es hacerle otro.
NYlOn


Desconectado Desconectado

Mensajes: 842


OOOOHHHHHH, TARAGÜIIII xDDDDDD


Ver Perfil WWW
Re: ProgressBar con un PictureBox (aportando code para todos).
« Respuesta #1 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


En línea

Numeros

Desconectado Desconectado

Mensajes: 110



Ver Perfil
Re: ProgressBar con un PictureBox (aportando code para todos).
« Respuesta #2 en: 21 Agosto 2005, 09:41 am »

Olvidate del timer..

Código:
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
« Última modificación: 21 Agosto 2005, 09:44 am por Numeros » En línea

NYlOn


Desconectado Desconectado

Mensajes: 842


OOOOHHHHHH, TARAGÜIIII xDDDDDD


Ver Perfil WWW
Re: ProgressBar con un PictureBox (aportando code para todos).
« Respuesta #3 en: 21 Agosto 2005, 19:31 pm »

thx ^^
ahora lo pruebo Numerito xD

un abraz0 ;)


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

Observacion:
Cambiar este code por

Código:
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:
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
En línea

Numeros

Desconectado Desconectado

Mensajes: 110



Ver Perfil
Re: ProgressBar con un PictureBox (aportando code para todos).
« Respuesta #4 en: 21 Agosto 2005, 22:19 pm »

Citar
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
« Última modificación: 21 Agosto 2005, 22:35 pm por Numeros » En línea

NYlOn


Desconectado Desconectado

Mensajes: 842


OOOOHHHHHH, TARAGÜIIII xDDDDDD


Ver Perfil WWW
Re: ProgressBar con un PictureBox (aportando code para todos).
« Respuesta #5 en: 22 Agosto 2005, 02:04 am »

UTIL ^^
thx ;D

bye
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Mango sigue aportando nuevas funciones
Noticias
wolfbcn 0 1,624 Último mensaje 28 Junio 2011, 02:39 am
por wolfbcn
¿Como Programar una progressbar para archivos?
Programación Visual Basic
josiko12 1 1,681 Último mensaje 19 Octubre 2013, 19:53 pm
por yree
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines