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.

---

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 SOME 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.