Visual Basic Window/Form Routines
Pure VB: Customizable PhotoShop-Style ProgressBar
     
Posted:   Saturday April 26, 1997
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB3, Windows 3.1
OS restrictions:   None
Author:   VBnet - Randy Birch
     

Related:  

SetParent: Add a VB Progress Bar to a VB StatusBar
SendMessage: Change the Colour of a VB ProgressBar
Pure VB: Customizable PhotoShop-Style ProgressBar in a MDI App
CreateWindowEx: Creating a Common Control Progress Bar - Overview
CreateWindowEx: Creating the Common Control Flood Panel via the API
SetParent: Display Modal Form Activity on a Parent Form's 'PhotoShop-style' Progress Bar
SetParent: Display Modal Form Activity in a Parent Form's VB Progress Bar
     
 Prerequisites
None.

bitbltflood.gif (4394 bytes)The routines on this page were originally developed to overcome display limitations of the original VB3 SSPanel FloodPercent control, namely use of and justification of text and the positioning the control as a member of a status panel. The routine was originally developed in VB3 and has been updated for use under all later versions of 32-bit VB. The methodologies remain more than viable alternatives to the standard flood/status panels provided.

The inspiration Adobe PhotoShop whose status panel indicates the progress of an operation by displaying a text message overtop the progress indicator with the reversed text colour to remain readable. The following code can be easily integrated into any existing project where a fully-customizable status panel is required. By using a picture box without borders or 3D effects and sizing it to a status panel, the original Adobe status panel is easily duplicated.

Despite the complicated form shown above, the actual implementation uses just one sub to perform the drawing of the text and progress, and a single picture box for the output. The size of the code here is due to my presenting the basic flood update routine in four flavours: percentage readout only, centred text only, left justified text with the percentage trailing, and positional text routine (my Favourite).

The illustration to the left is just a collage of several screen shots showing the effect using different options; there's no need to actually create this form. The differences in the values between each example is due to capturing each mode using print screen while running.

Notes: The "BitBlit" caption on the "BitBlt Demo" button in the demo was a throwback to the original VB3 code, which required the data to be copied to the picture box via API. The API is no longer required, so for all intents and purposes it should now simply say "Test".

 BAS Module Code
None.

 Form Code
Although the actual routine is relatively straightforward, to create this demo, start a new project with a form add a picture box to become the flood window (tbFlood), along with five command buttons (Command1, Command2, Command3, Command4 and Command5).

Next, add an option button array of four buttons (optFloodColour(0) - optFloodColour(3)), and a second option array of three buttons inside a frame or second picture box and name these controls optTextPosition(0) - optTextPosition(2). The demo illustration uses a frame with the BorderStyle set to 0. Add a label over the picture box (Label1) just to reflect the action taking place.

To easily demonstrate the appearance of different strings as the flood message, add a combo box (Combo1) set to type 0 to allow you to type in your own message.

Add the following code to the form:


Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private floodPos As Long

Private Sub Form_Load()
   
   'position the form 1/3 up the screen   
    Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 3
           
   'set the flood's initial attributes  
   'white text (trust me, I know it says backcolor !)   
    tbFlood.BackColor = &HFFFFFF
    tbFlood.DrawMode = 10
       
   'solid fill   
    tbFlood.FillStyle = 0
    tbFlood.AutoRedraw = True 'required to prevent flicker!
   
   'initialize the controls       
    Combo1.AddItem "Loading user preferences ... please wait."
    Combo1.AddItem "Loading ... please wait."
    optFloodColour(0).Value = True
    optTextPosition(0).Value = True
    Combo1.ListIndex = 0
    
    Command1.Caption = "BitBlit Demo"
    Command2.Caption = "Percent Only"
    Command3.Caption = "Text && Percent"
    Command4.Caption = "Positioned Text"
    Command5.Caption = "End"                

End Sub


Private Sub Command5_Click()

    Unload Me
    
End Sub


Private Sub Command1_Click()
  
    Label1.Caption = "PhotoShop Progress Panel inversion demo ..."
    FloodUpdatePercent 100, 48

End Sub


Private Sub Command2_Click()

    Dim cnt As Long
    Dim unit As Long
    Dim upperLimit As Long
    Dim progress As Long
   
   'The tbFloodUpdatePercent sub requires 3 pieces of information:
   '  - the upperlimit of the items to count to.
   '  - the total progress-to-date.
   '  - the increment unit used to update the progress.
  
   'There are several ways of doing this: you could
   '  - pass upperLimit and value, and store static progress in the sub;
   '  - pass upperLimit and progress, and perform the math in
   '    each routine calling the flood (as shown below); or
   '  - pass all three variables back and forth
  
   'The upperLimit is the number of things to count to.
   'For example, if you are counting a 1534-record
   'random access file, the code might be:
   '  upperLimit = LOF(#MyFile) / MyType
   
   'For demo purposes, a limit of 250 is used

   'The 'unit' is the counting increment - typically this
   'would be one (as in once each record), but can be
   'changed to reflect actions in chunks.
   
   ''progress' is the total accumulated thus far.      
    unit = 1
    upperLimit = 1000
    
    Label1.Caption = "Processing..."
    
    For cnt = 1 To upperLimit
    
      '(your code for some method goes here)

      'update the status display
       progress = progress + unit
       FloodUpdatePercent upperLimit, progress
       
    Next
    
    Label1.Caption = "Complete."

End Sub


Private Sub Command3_Click()
    
    Dim cnt As Long
    Dim unit As Long
    Dim upperLimit As Long
    Dim progress As Long

    unit = 1
    upperLimit = 1000
    
    Label1.Caption = "Processing..."
    
    For cnt = 1 To upperLimit
       
      '(your code for some method goes here)
      
      'update the status display
       progress = progress + unit
       FloodUpdateTextPC upperLimit, progress, (Combo1.Text)
       
    Next
    
    Label1.Caption = "Complete."
    
End Sub


Private Sub Command4_Click()

    Dim cnt As Long
    Dim unit As Long
    Dim upperLimit As Long
    Dim progress As Long

    unit = 1
    upperLimit = 1000
    
    Label1.Caption = "Processing..."
    
    For cnt = 1 To upperLimit
       
      '(your code for some method goes here)
      
      'update the status display   
       progress = progress + unit
       FloodUpdateText upperLimit, progress, (Combo1.Text)
       
    Next
    
    Label1.Caption = "Complete."

End Sub


Private Sub optFloodColour_Click(Index As Integer)
   
   'set the floodcolour by setting the ForeColor !!
    Select Case Index
      Case 0: tbFlood.ForeColor = &H0& 'black 
      Case 1: tbFlood.ForeColor = &H800000 'blue 
      Case 2: tbFlood.ForeColor = &H80& 'red 
      Case 3: tbFlood.ForeColor = &H808000 'teal
    End Select
    
End Sub


Private Sub optTextPosition_Click(Index As Integer)

    floodPos = Index
  
End Sub


Private Sub FloodUpdatePercent(upperLimit As Long, progress As Long)

    Dim msg As String
    
   'make sure that the flood display hasn't already hit 100%
    If progress <= upperLimit Then      

     'error trap in case the code attempts 
     'to set the scalewidth greater than
     'the max allowable 
      If progress> tbFlood.ScaleWidth Then
         progress = tbFlood.ScaleWidth
      End If
            
     'erase the flood
      tbFlood.Cls
                  
     'set the ScaleWidth equal to the upper limit of the items to count
      tbFlood.ScaleWidth = upperLimit
      
     'format the progress into a percentage string to display
      msg = Format$(CLng((progress / tbFlood.ScaleWidth) * 100)) + "%"
       
     'calculate the string's X & Y coordinates
     'in the PictureBox ... here, centered   
      tbFlood.CurrentX = (tbFlood.ScaleWidth - tbFlood.TextWidth(msg)) \ 2
      tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(msg)) \ 2
         
     'print the percentage string in the text colour
      tbFlood.Print msg
        
     'print the flood bar to the new progress length in the line colour
      tbFlood.Line (0, 0)-(progress, tbFlood.ScaleHeight), tbFlood.ForeColor, BF
       
     'allow the flood to complete drawing
      DoEvents
    
    End If

End Sub


Private Sub FloodUpdateTextPC(upperLimit As Long, progress As Long, msg As String)

    Dim r As Long
    Dim pc As String
    
    If progress <= upperLimit Then 

      If progress > tbFlood.ScaleWidth Then
         progress = tbFlood.ScaleWidth
      End If
           
      tbFlood.Cls
      tbFlood.ScaleWidth = upperLimit
          
     'format the progress into a percentage string to display
      pc = Format$(CLng((progress / tbFlood.ScaleWidth) * 100)) + "%"
           
     'calculate the string's X & Y coordinates
     'in the PictureBox ... here, left justified and offset slightly
      tbFlood.CurrentX = 2 
      tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(msg)) \ 2
           
     'print the percentage string in the text colour
      tbFlood.Print msg & " " & pc
          
     'print the flood bar to the new progress length in the line colour
      tbFlood.Line (0, 0)-(progress, tbFlood.ScaleHeight), tbFlood.ForeColor, BF
           
      DoEvents
    
    End If

End Sub

Private Sub FloodUpdateText(upperLimit As Long, progress As Long, msg As String)

    Dim r As Long
    
    If progress <= upperLimit Then

      If progress > tbFlood.ScaleWidth Then
         progress = tbFlood.ScaleWidth
      End If
           
      tbFlood.Cls
      tbFlood.ScaleWidth = upperLimit
          
     'calculate the string's X & Y coordinates
     'in the PictureBox based on the floodPos set
      Select Case floodPos
        Case 0  'left
                 tbFlood.CurrentX = 2
                 tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(msg)) \ 2
        
        Case 1  'centered
                 tbFlood.CurrentX = (tbFlood.ScaleWidth - tbFlood.TextWidth(msg)) \ 2
                 tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(msg)) \ 2
                  
        Case 2  'right
                 tbFlood.CurrentX = (tbFlood.ScaleWidth - tbFlood.TextWidth(msg)) - 3
                 tbFlood.CurrentY = (tbFlood.ScaleHeight - tbFlood.TextHeight(msg)) \ 2
      End Select
           
     'print the string in the
     'at the position set above
      tbFlood.Print msg
          
     'print the flood bar to the new
     'progress length in the line colour
      tbFlood.Line (0, 0)-(progress, tbFlood.ScaleHeight), tbFlood.ForeColor, BF
    
      DoEvents
    
    End If

End Sub
 Comments
The Command1 button simply sets the tbFlood to 48% completed, to illustrate what the output will look like. The remaining command buttons activate the different flood Update methods. Practically, in a final app you would normally chose just one method for use throughout the application. The speed of the progress bar is a product of the upper limit, and the current count cycle. For example, a call with an upper limit of 100,000 and a step ratio of 1 will take a few seconds to run, whereas a call with an upper limit of 100 with the same ratio will complete faster. Similarly, a step ratio of 10 will cause the bar to run faster than a ratio of 1.

Because you are, in effect, setting the BackColor for the text and the ForeColor for the background, certain colour combinations can lead to rather interesting results.

In practical use, you may want to consider the addition of two additional routines coded below. In my implementation, I used one status panel (of an SSPanel) for text display during the course of the app running. Into this panel I placed the tbFlood as well, and only made it visible when there was a need to indicate a long running process. Therefore, I needed routines to hide and display the tbFlood as needed. My solution was place all the flood-related code into a BAS module, and to code two additional routines that were called before and after each tbFlood usage:

Public Sub FloodDisplay (upperLimit As Integer)

    parentForm!tbFlood.Cls
    parentForm!tbFlood.Visible = True
    parentForm!tbFlood.ScaleWidth = upperLimit
    parentForm!tbFlood.CurrentX = upperLimit * .03
  
End Sub


Public Sub FloodHide ()

    parentForm!tbFlood.Visible = False
    parentForm!tbFlood.Cls
  
End Sub


'To use these routines, I called them in routines as:

    FloodDisplay TotalClients
    msg = "Retrieving Client Data .."
    
      For cnt = 1 To TotalClients
    
        Get #ClientFileNo, cnt, Client
     
        FloodUpdate cnt, msg
      
       '(your code for some method goes here)
        
      Next cnt
    
    FloodHide

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter