form1.frm

进度条编写.......很好,很强大

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3225
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6360
   LinkTopic       =   "Form1"
   ScaleHeight     =   3225
   ScaleWidth      =   6360
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdGo 
      Caption         =   "Go"
      Height          =   495
      Left            =   960
      TabIndex        =   2
      Top             =   360
      Width           =   1215
   End
   Begin MSComctlLib.ProgressBar ProgressBar1 
      Height          =   255
      Left            =   480
      TabIndex        =   1
      Top             =   2160
      Width           =   2535
      _ExtentX        =   4471
      _ExtentY        =   450
      _Version        =   393216
      Appearance      =   1
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      TabIndex        =   0
      Top             =   2925
      Width           =   6360
      _ExtentX        =   11218
      _ExtentY        =   529
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent 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 MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Const WM_USER = &H400
Private Const SB_GETRECT As Long = (WM_USER + 10)

Public Sub MoveIntoStatusBar(ByVal sbr As StatusBar, ByVal ctl As Control, ByVal panel_number As Long)
Dim r As RECT

    ' Reparent the control into the status bar.
    SetParent ctl.hWnd, sbr.hWnd

    ' Get the status bar's panel's rectangle.
    SendMessage sbr.hWnd, SB_GETRECT, panel_number - 1, r

    ' Position the control in the panel.
    MoveWindow ctl.hWnd, r.Left, r.Top, r.Right - r.Left, r.Bottom - r.Top, True
End Sub

Private Sub SetProgress(ByVal txt As String, ByVal progress_value As Integer)
    StatusBar1.Panels(1).Text = txt
    StatusBar1.Refresh

    ProgressBar1.Value = progress_value
    ProgressBar1.Refresh
End Sub
Private Sub WasteTime(ByVal seconds As Single)
Dim stop_time As Single

    stop_time = Timer + seconds
    Do While Timer < stop_time
    Loop
End Sub

Private Sub cmdGo_Click()
    ProgressBar1.Min = 0
    ProgressBar1.Max = 7

    SetProgress "Step 1 of 4", 1
    WasteTime 0.5
    SetProgress "Step 1 of 4", 2
    WasteTime 0.5

    SetProgress "Step 2 of 4", 3
    WasteTime 0.5

    SetProgress "Step 3 of 4", 4
    WasteTime 0.5

    SetProgress "Step 4 of 4", 5
    WasteTime 0.5
    SetProgress "Step 4 of 4", 6
    WasteTime 0.5

    SetProgress "Done", 0
End Sub
Private Sub Form_Load()
    StatusBar1.Panels.Clear

    With StatusBar1.Panels.Add()
        .Text = ""
    End With

    With StatusBar1.Panels.Add()
        .Width = 2 * 1440
    End With
    MoveIntoStatusBar StatusBar1, ProgressBar1, 2

    With StatusBar1.Panels.Add()
        .Style = sbrTime
        .AutoSize = sbrSpring
    End With
End Sub