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 Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long <#Module=mod> Const GWL_WNDPROC = -4 Const GWL_STYLE = (-16) Const WS_CHILD = &H40000000 Const WS_VISIBLE = &H10000000 Const PB_CLASS_NAME = "msctls_progress32" Const PBM_SETRANGE = &H401 Const PBM_SETPOS = &H402 Const PBM_DELTAPOS = &H403 Const PBM_SETSTEP = &H404 Const PBM_STEPIT = &H405 Const PBS_VERTICAL = &H4 Dim PB Sub Load(cmdLine) form1.ScaleMode = 3 Set PB = New ProgBar PB.Create form1.hWnd, 20, 20, 350, 40 PB.Min = 0 'Default PB.Max = 100 'Default PB.Value = 0 'Default PB.Vertical = False 'Default form1.Add "Command", 1 form1.Command(1).Move 120, 75, 90, 25 form1.Command(1).Caption = "Start" form1.NoMoveMouse = true form1.center form1.Show End Sub Class ProgBar Dim h_ProgBar, m_DeltaPos, m_Min, m_Max, m_Value, m_Vertical, m_Left, m_Top, m_Width, m_Height Private Sub Class_Initialize() m_Min = 0 m_Max = 100 m_Value = 0 m_Vertical = False SetRange SetStyle End Sub Private Sub Class_Terminate() Call DestroyWindow(h_ProgBar) End Sub Public Sub Create(hWnd, n_Left, n_Top, n_Width, n_Height) h_ProgBar = CreateWindowEx(0, PB_CLASS_NAME, vbNullString, WS_CHILD Or WS_VISIBLE, n_Left, n_Top, n_Width, n_Height, hWnd, 0, 0, 0) End Sub Public Property Get Min() Min = m_Min End Property Public Property Let Min(New_Min) m_Min = New_Min SetRange End Property Public Property Get Max() Max = m_Max End Property Public Property Let Max(New_Max) m_Max = New_Max SetRange End Property Public Property Get hWnd() hWnd = h_ProgBar End Property Public Property Get Value() Value = m_Value End Property Public Property Let Value(New_Value) m_Value = New_Value SetValue End Property Public Property Get Vertical() Vertical = m_Vertical End Property Public Property Let Vertical(New_Vertical) m_Vertical = New_Vertical SetStyle End Property Private Sub SetStyle() Dim lS lS = GetWindowLong(h_ProgBar, GWL_STYLE) If m_Vertical Then lS = lS Or PBS_VERTICAL Else lS = lS And Not PBS_VERTICAL SetWindowLong h_ProgBar, GWL_STYLE, lS SetValue End Sub Private Sub SetValue() SendMessage h_ProgBar, PBM_SETPOS, m_Value, 0 End Sub Private Sub SetRange() On Error Resume Next Dim R R = CLng((m_Min And &HFFFF&) Or ((m_Max And &HFFFF&) * 65536)) If h_PB <> 0 Then SendMessage h_ProgBar, PBM_SETRANGE, 0, R End Sub End Class <#Module> <#Form=form1> Sub Command1_Click() Dim x x = 0 form1.Command(1).Enabled = False Do If x > 100 Then x = 0 PB.Value = x x = x + 1 Sleep 50 DoEvents Loop Until isEnd End Sub Sub Form_Unload() endmf End Sub <#Form>