[VBnet ComCtrls] SetParent: Add a VB Progress Bar to a VB StatusBar


	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

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

Prerequisites

None.

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

None.

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
Private Const PBM_SETBKCOLOR  As Long = CCM_SETBKCOLOR

'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"
      Next
   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
      DoEvents
   
   Next
   
   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

Comments

PayPal Link