Customized Progress Bar in VB6 using Image Control

In order to implement a progress bar in VB6 you need to enable the component "Microsoft Windows Common Controls #.#" before you can add this control on your form.

In this example, you won't need any extra Controls that will require another libraries when running the app on another system. What you will need is a standard Label, Image, Timer controls and the Sleep API declaration to implement a smooth progress of the Progress Bar.

CODE:

Option Explicit

'   #################################################################
'   #  By:         Cromwell Bayon (omelsoft@gmail.com)
'   #  Description:    Progress Bar Using Custom Image
'   #  Date:           Friday 12th of April, 2013 
'   #################################################################

' DECLARE PROGRESS BAR VARIABLES
Public iMax As Long, _
       iMin As Long, _
       u_Val As Long, _
       xMinVal As Long, _
       xMaxVal As Long, _
       xPBar As Long       

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

' INITIALIZE PROGRESS BAR STATE
Public Function initProgress(ByVal xMin As Long, ByVal xMax As Long, pBar As Image) 

    pBar.Visible = True
    lblPercent.Caption = ""

    'SAVE INITIAL VALUES
    xMinVal = xMin

    'THIS IS THE WIDTH OF OUR PROGRESS BAR FACE
    'MAY ALSO SET THIS TO FIX VALUE
    'xPbar = 7080

    xPBar = pBar.Width

    'THE INITIAL WIDTH OF THE PROGRESS BAR FACE
    pBar.Width = 1

    'WE'LL TRAP ZERO VALUES
    If xMin = 1 Then
       xMaxVal = xMax
    Else
       xMaxVal = Abs(xMax - xMin)
    If xMin < 1 Then 
       xMaxVal = xMaxVal + 1
    End If
End Function

'DRAW PROGRESS BAR STATE
Public Function drawProgress(ByVal xVal As Long)
   'GET THE ABSOLUTE VALUE OF THE xVal
   u_Val = Abs(xVal - xMinVal) + 1

   'PROGRESS BAR WIDTH
   pBar.Width = (u_Val * xPBar) / xMaxVal

   'UPDATE PERCENTAGE OF THE PROGRESS BAR
   lblPercent.Caption = CStr(Int(u_Val * 100 / xMaxVal)) & " %"
End Function

Private Sub cmdStart_Click()
   If txtMax.Text < 1 Then
     'DO SOME TRAPPING HERE LIKE NO RECORD FOUND WHILE GETTING DATA FROM A DATABASE
      MsgBox "Max value must be greater than 1."
      Exit Sub
   End If

   'INITIALIZE MIN AND MAX VALUES
   initProgress txtMin.Text, txtMax.Text, Me.pBar

   'ENABLE TIMER
   Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
   Dim i As Integer

   For i = 1 To xMaxVal

       'DRAW PROGRESS BAR
       drawProgress i

       'PAUSE FOR 25 milli SECONDS TO IMPLEMENT A SMOOTH PROGRESS
       Sleep 25

       'LET OS DO OTHER TASKS
       DoEvents    
    Next i

    If Mid(lblPercent.Caption, 1, 3) >= 100 Then
       Timer1.Enabled = False
       MsgBox "Done! ^_^", vbInformation, Me.Caption
    End If

End Sub

Download the sample here.