Visual Basic Common Control API Routines
Adding a VB ProgressBarto a VB StatusBar
Posted:   Thursday February 07, 2002
Updated:   Monday December 26, 2011
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch


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

Similar to the code to add a VB toolbar to a statusbar, this page shows how to do the same with a VB progress bar control.

Normally, to calculate the position the progress bar should occupy in the status bar panel, one would calculate the panel position relative to the top left corner of the form, and adjust the coordinates appropriately.  However, I found this can be circumvented by temporarily changing the status bar alignment to the top of the form, thereby providing a natural offset to the form's corner. Therefore, this code on re-parenting hides the status bar, adjusts the control's alignment, calculates the horizontal offset to the panel specified as the 'home' for the progress bar, changes the parent, and re-shows the controls aligned at the bottom of the form.

The statusbar panel containing the toolbar uses the default AutoSize (no sizing), thereby assuring that the progress bar remains in the current position in the statusbar (and as long as all other panels preceding the progress bar panel retains their same size).  For those wishing to position the progress bar inside a panel that dynamically changes width on form resizing, you will need to add extra code to detect when the form is resized, the new position of the toolbar panel, and then move the toolbar to this new location.  The best results for this would be achieved using subclassing of the status bar. Those happy with the progress bar inside a fixed-width panel (so long as all preceding it are sbrNoAutoSize), will find this code works without change.

The Load event of the form handles all the details in creating the progress bar and status bar for this demo. All that is required on the form is a blank status bar, a progress bar and two command buttons..

 BAS Module Code

 Form Code
Add a progress bar (ProgressBar1), statusbar (StatusBar1), and two command buttons (Command1, Command2) to the form along with the following code:

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 defProgBarHwnd  As Long

Private Declare Function SetParent Lib "user32" _
  (ByVal hWndChild As Long, _
   ByVal hWndNewParent As Long) As Long
'used to change progressbar colour
Private Const WM_USER = &H400
Private Const CCM_FIRST       As Long = &H2000&
Private Const CCM_SETBKCOLOR  As Long = (CCM_FIRST + 1)

'set progressbar backcolor in IE3 or later

'set progressbar barcolor in IE4 or later
Private Const PBM_SETBARCOLOR As Long = (WM_USER + 9)

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 Sub Form_Load()

   Dim pnl As Panel
   Dim btn As Button
   Dim x As Long
  'create statusbar
   With StatusBar1
      For x = 1 To 3
         Set pnl = .Panels.Add(, , "", sbrText)
         pnl.Alignment = sbrLeft
         pnl.Width = 1800
         pnl.Bevel = sbrInset
         If x = 3 Then pnl.AutoSize = sbrSpring
         If x = 1 Then pnl.Text = "Status/Progbar Demo"
   End With
   Command1.Caption = "Set Progbar"
   Command2.Caption = "Run Progbar"
   With ProgressBar1
      .Min = 0
      .Max = 10000
      .Value = .Max
   End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
   If defProgBarHwnd  <> 0 Then
      SetParent ProgressBar1.hwnd, defProgBarHwnd 
   End If
End Sub

Private Sub Command1_Click()
   Dim pading As Long

  'parent the progress bar in the status bar
   pading = 40
   AttachProgBar ProgressBar1, StatusBar1, 2, pading
  'change the bar colour
   Call SendMessage(ProgressBar1.hwnd, _
                    PBM_SETBARCOLOR, _
                    0&, _
                    ByVal RGB(205, 0, 205))

   ProgressBar1.Value = 0
End Sub

Private Sub Command2_Click()

   Dim cnt As Long
   Dim tmp As String
   tmp = StatusBar1.Panels(1).Text
   StatusBar1.Panels(1).Text = "Processing ..."
   For cnt = 1 To ProgressBar1.Max
      ProgressBar1.Value = cnt
     'needed to trap cancel click
   StatusBar1.Panels(1).Text = tmp
   ProgressBar1.Value = 0
End Sub

Private Function AttachProgBar(pb As ProgressBar, _
                               sb As StatusBar, _
                               nPanel As Long, _
                               pading As Long)
   If defProgBarHwnd  = 0 Then
     'change the parent
      defProgBarHwnd  = SetParent(pb.hwnd, sb.hwnd)
      With sb
        'adjust statusbar. Doing it this way
        'relieves the necessity of calculating
        'the statusbar position relative to the
        'top of the form. It happens so fast
        'the change is not seen.
         .Align = vbAlignTop
         .Visible = False
        'change, move, set size and re-show
        'the progress bar in the new parent
         With pb
            .Visible = False
            .Align = vbAlignNone
            .Appearance = ccFlat
            .BorderStyle = ccNone
            .Width = sb.Panels(nPanel).Width
            .Move (sb.Panels(nPanel).Left + pading), _
                 (sb.Top + pading), _
                 (sb.Panels(nPanel).Width - (pading * 2)), _
                 (sb.Height - (pading * 2))
            .Visible = True
            .ZOrder 0
         End With
        'restore the statusbar to the
        'bottom of the form and show
         .Panels(nPanel).AutoSize = sbrNoAutoSize
         .Align = vbAlignBottom
         .Visible = True
       End With
    End If
End Function


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