Attribute VB_Name = "modProgressBar"
Option Explicit
'
'
'=============================================================================================================
'
' modProgressBar Module
' ---------------------
'
' Created By  : Kevin Wilson
'               http://www.TheVBZone.com   ( The VB Zone )
'               http://www.TheVBZone.net   ( The VB Zone .net )
'
' Last Update : February 25, 2003
' Created On  : April 01, 2000
'
' VB Versions : 5.0 / 6.0
'
' Requires    : A standard VB PictureBox placed on a Form, UserControl, etc
'
' Description : This module takes any ordinary PictureBox control and turns it into a fully functional
'               dynamic ProgressBar.  No need to add Microsoft Common Controls to your project just to get
'               a simple ProgressBar... just add a PictureBox to a form and call the "ProgressBar" function.
'
' Example Use :
'
' Dim MyCounter As Long
' Dim Total As Long
' Me.Visible = True
' Total = 500
' For MyCounter = 0 To Total
'   ProgressBar Picture1, 0, Total, MyCounter, True, vbHighlightText, vbHighlight, vbButtonFace, vbCenter
'   Me.Width = Me.Width + Screen.TwipsPerPixelX
'   Me.Width = Me.Width - Screen.TwipsPerPixelX
' Next
' Me.Caption = "  Finished!"
'
'=============================================================================================================
'
' LEGAL:
'
' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit
' given where credit is due.  Also, it is not required, but it would be appreciated if you would mention
' somewhere in your compiled program that that your program makes use of code written and distributed by
' Kevin Wilson (www.TheVBZone.com).  Feel free to link to this code via your web site or articles.
'
' You may NOT take this code and pass it off as your own.  You may NOT distribute this code on your own server
' or web site.  You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products,
' utilities, or applications that directly compete with products, utilities, and applications created by Kevin
' Wilson, TheVBZone.com, or Wilson Media.  You may NOT take this code and sell it for profit without first
' obtaining the written consent of the author Kevin Wilson.
'
' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without
' warning or notice.  Copyright© by Kevin Wilson.  All rights reserved.
'
'=============================================================================================================


Public Function ProgressBar(ByRef ThePictureBox As PictureBox, ByVal Min As Long, ByVal Max As Long, ByVal Value As Long, Optional ByVal ShowProgressCaption As Boolean = False, Optional ByVal ForeColor As Long = 16777215, Optional ByVal BackColor As Long = 16711680, Optional ByVal FillColor As Long = vbButtonFace, Optional ByVal Alignment As AlignmentConstants = vbCenter, Optional ByVal ByPassChecks As Boolean = False)
On Error Resume Next
  
  Dim TheCaption As String
  Dim RangeDiff As Long
  
  ' Make sure a PictureBox control was specified
  If ThePictureBox Is Nothing Then Exit Function
  
  If ByPassChecks = False Then
    
    ' Make sure the AutoRedraw property is on, or the ProgressBar will be
    ' blank if the PictureBox is repainted by Windows
    ThePictureBox.AutoRedraw = True
    
    ' Make sure the PictureBox doesn't AutoSize
    ThePictureBox.AutoSize = False
    
    ' Make sure there's no picture set
    Set ThePictureBox.Picture = Nothing
    
    ' Make sure progressbar is visible
    ThePictureBox.Visible = True
    
  End If
  
  ' Calculate the percent of the progressbar
  RangeDiff = Max - Min
  If RangeDiff = 0 Then
    TheCaption = "0.0%"
  Else
    TheCaption = Format((Value - Min) / RangeDiff, "0.0%")
  End If
  
  ' Draw the lines on the PictureBox that make it look like a ProgressBar
  If RangeDiff = 0 Then
    ThePictureBox.Line (0, 0)-(0, ThePictureBox.ScaleHeight), BackColor, BF
    ThePictureBox.Line (0, 0)-(ThePictureBox.ScaleWidth, ThePictureBox.ScaleHeight), FillColor, BF
  Else
    ThePictureBox.Line (0, 0)-((((Value - Min) / RangeDiff) * ThePictureBox.ScaleWidth), ThePictureBox.ScaleHeight), BackColor, BF
    ThePictureBox.Line ((((Value - Min) / RangeDiff) * ThePictureBox.ScaleWidth), 0)-(ThePictureBox.ScaleWidth, ThePictureBox.ScaleHeight), FillColor, BF
  End If
  
  ' If no caption, exit
  If ShowProgressCaption = False Then
    ThePictureBox.Refresh
    Exit Function
  End If
  
  ' Set the text location depending on where the user specified
  If Alignment = vbCenter Then
    ThePictureBox.CurrentX = (ThePictureBox.ScaleWidth / 2 - ThePictureBox.TextWidth(TheCaption) / 2)
  ElseIf Alignment = vbLeftJustify Then
    ThePictureBox.CurrentX = 1
  ElseIf Alignment = vbRightJustify Then
    ThePictureBox.CurrentX = (ThePictureBox.ScaleWidth - ThePictureBox.TextWidth(TheCaption)) - 1
  End If
  ThePictureBox.CurrentY = (ThePictureBox.ScaleHeight - ThePictureBox.TextHeight(TheCaption)) / 2
  
  ' Print the caption directly onto the PictureBox
  ThePictureBox.ForeColor = ForeColor
  ThePictureBox.Print TheCaption
  ThePictureBox.Refresh
  
End Function