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 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 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) 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 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&) CreateProgBar = Not (c_lhWnd = 0) 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