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

 

 


Tema destacado: Rompecabezas de Bitcoin, Medio millón USD en premios


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  ProgresBar indefinido (source)
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: ProgresBar indefinido (source)  (Leído 3,622 veces)
LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
ProgresBar indefinido (source)
« en: 30 Septiembre 2008, 20:45 pm »

Buenas esta es una simple funcion para agregar un progreso indefinido a las barra de progreso tal como lo hacen muchos programas o cuando se ejecuta una busqueda en el disco

una imagen de ejemplo



agregar un progressbar1 (de la version Common Controls 5)
Código:
Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Const GWL_STYLE = (-16)
Private Const WM_USER           As Long = &H400
Private Const PBS_MARQUEE       As Long = 8
Private Const PBM_SETMARQUEE = (WM_USER + 10)


Private Sub Form_Load()
    Dim Ret As Long
    Ret = SetStyleMarquee(ProgressBar1.hwnd, 50)
    If Ret = False Then
        MsgBox "No se pudo aplicar el estilo"
    End If
End Sub


Public Function SetStyleMarquee(hwnd As Long, Velocity As Long) As Boolean
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) Or PBS_MARQUEE
    SetStyleMarquee = SendMessageLong(hwnd, PBM_SETMARQUEE, 1, Velocity)
End Function

Lo compilan y agregan un archivo Proyecto1.exe.manifest junto al ejecutable, sino no funciona.

Me han dicho que con algunos themes de windows no funciona. aver que les pasa a ustedes.





 


« Última modificación: 30 Septiembre 2008, 20:54 pm por LeandroA » En línea

LeandroA
Moderador
***
Desconectado Desconectado

Mensajes: 760


www.leandroascierto.com


Ver Perfil WWW
Re: ProgresBar indefinido (source)
« Respuesta #1 en: 30 Septiembre 2008, 20:51 pm »

Aca le implente esta funcion a la clase de Cobein para crear el progresbar con las apis.

Código:
'---------------------------------------------------------------------------------------
' Module      : cProgBar
' DateTime    : 28/07/2008 09:23
' Author      : Cobein
' Mail        : cobein27@hotmail.com
' WebPage     : http://cobein27.googlepages.com/vb6
' Purpose     : Mini ProgressBar class
' Usage       : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
'
' History     : 28/07/2008 First Cut....................................................
'---------------------------------------------------------------------------------------
Option Explicit
 
Private Const PROGRESS_CLASSA   As String = "msctls_progress32"
 
Private Const WS_VISIBLE        As Long = &H10000000
Private Const WS_CHILD          As Long = &H40000000
 
Private Const WM_USER           As Long = &H400
Private Const PBM_SETPOS        As Long = (WM_USER + 2)
Private Const PBS_SMOOTH        As Long = &H1
Private Const PBS_VERTICAL      As Long = &H4
Private Const PBS_MARQUEE       As Long = 8

Private Const PBM_SETMARQUEE = (WM_USER + 10)
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private c_lhWnd As Long
Private c_lVal  As Long
 
Public Function CreateProgBar( _
       ByVal lhWndOwner As Long, _
       ByVal Left As Long, _
       ByVal Top As Long, _
       ByVal Width As Long, _
       ByVal Heght As Long, _
       Optional ByVal bHorizontal As Boolean = True, _
       Optional ByVal bSmooth As Boolean = False, _
       Optional ByVal bMarquee As Boolean = False, _
       Optional ByVal Velocity As Integer = 0) As Boolean
       
    Dim lFlag As Long
 
    lFlag = WS_CHILD Or WS_VISIBLE
    If Not bHorizontal Then lFlag = lFlag Or PBS_VERTICAL
    If bSmooth Then lFlag = lFlag Or PBS_SMOOTH
    If bMarquee Then lFlag = lFlag Or PBS_MARQUEE
   
    If Not c_lhWnd = 0 Then Class_Terminate
 
    c_lhWnd = CreateWindowEx(0, PROGRESS_CLASSA, vbNullString, _
       lFlag, Left, Top, Width, Heght, _
       lhWndOwner, vbNull, App.hInstance, ByVal 0&)
       
    If bMarquee Then
        If c_lhWnd Then
            CreateProgBar = SendMessageLong(c_lhWnd, PBM_SETMARQUEE, 1, Velocity)
        End If
    Else
        CreateProgBar = c_lhWnd
    End If
       

End Function
 
Public Property Let Value(ByVal lVal As Long)
    If Not c_lhWnd = 0 Then
        c_lVal = lVal
        Call SendMessage(c_lhWnd, PBM_SETPOS, ByVal lVal, ByVal 0&)
    End If
End Property
 
Public Property Get Value() As Long
    Value = c_lVal
End Property
 
Private Sub Class_Initialize()
    '
End Sub
 
Private Sub Class_Terminate()
    If Not c_lhWnd = 0 Then
        Call DestroyWindow(c_lhWnd)
        c_lhWnd = 0
    End If
End Sub

y lo llamamos asi
Código:
Option Explicit
Dim Progress As New cProgBar

Private Sub Form_Load()
    Progress.CreateProgBar Me.hwnd, 10, 10, 200, 30, True, True, True, 0
End Sub

y lo mismo hay que compliarlo y agregar el archivo Proyecto1.exe.manifest

Saludos


En línea

cobein


Desconectado Desconectado

Mensajes: 759



Ver Perfil WWW
Re: ProgresBar indefinido (source)
« Respuesta #2 en: 30 Septiembre 2008, 21:46 pm »

hahah muy lindo =) agregate en los creditos.
En línea

http://www.advancevb.com.ar
Más Argentino que el morcipan
Aguante el Uvita tinto, Tigre, Ford y seba123neo
Karcrack es un capo.
~~
Ex-Staff
*
Desconectado Desconectado

Mensajes: 2.981


Ver Perfil WWW
Re: ProgresBar indefinido (source)
« Respuesta #3 en: 1 Octubre 2008, 01:39 am »

Muy buen aporte Leandro, últimamente la tengo muy descuidada, pero te lo añado a la biblioteca de sources, si alguien tene por ahí algún código que se me haya pasado... :P
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Progresbar sin que titile la pantalla
Scripting
pssnelgj 0 1,730 Último mensaje 12 Mayo 2012, 02:29 am
por pssnelgj
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines