[VBnet ComCtrls] CreateWindowEx: Create the Common Control ProgressBar


	Visual Basic Common Control API Routines CreateWindowEx: Create the Common Control ProgressBar

Posted:	Sunday June 29, 1997
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6
Developed with:	VB4-32, Windows 95
OS restrictions:	None
Author:	Brad Martinez

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

Prerequisites

None. For additional information on the progress bar members used, see Creating the Common Control ProgressBarvia the API - An Overview

This is based on the original article written for VBnet by Brad Martinez explaining the ins & outs of the Win32 / NT4 "comctl32.dll" common control library, here showing how to implement a fully-functional API ProgressBarexposed by comctl32.dll without the use of either comctl32.ocx or mscomctl.ocx.

The advantages of this implementation are obviously beneficial. First and foremost, the need to distribute an ocx control with your application is removed reducing distribution size. Also, an application's memory footprint is significantly reduced by not loading an ActiveX control. Finally, there is a noticeable improvement in performance. As long as you do not require your progress bar to handle and process mouse events, this demo is for you. (To work around this you can implement your own events via either a subclassing control or the AddressOf operator. This however is not shown here.)

The dwIterations variable used in the Command1_Click code represents the number of items you are processing (e.g. the number of files if iterating through a folder, or the number of records if iterating through a database). The progress bar whose values are set via PBM_SETRANGE - as in this demo - is limited to a maximum of 32k items. For larger number of items the PBM_SETRANGE32 message is used instead, however this requires a different SendMessage calling syntax to pass the low and high points of the progress bar range.

BAS Module Code

None.

Form Code

Create a new form and add a text box (Text1), check box (Check1), command button (Command1), and two labels (Label1, Label2). The blue labels show in the illustration are not required for this demo. Add the following to the general declarations section of the form; the Load code will position and label the controls. Note that the code creates the progress bar along the bottom of the form, so don't size the demo form window too large for testing.

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

'The progress bar's Form_Resize() module level variables
Private hProgBar As Long     'hWnd
Private dwPBPosLeft As Long  'static x position when vertical
Private dwPBPosTop As Long   'static y position when horizontal

'SetWindowLong param
Private Const GWL_STYLE As Long = (-16)
 
'Restricts input in the text box control to digits only
Private Const ES_NUMBER As Long = &H2000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_CHILD As Long = &H40000000
Private Const WM_USER = &H400
Private Const PBM_SETRANGE = (WM_USER + 1)
Private Const PBM_SETPOS = (WM_USER + 2)
Private Const PBM_SETSTEP = (WM_USER + 4)
Private Const PBM_STEPIT = (WM_USER + 5)
Private Const PBM_SETRANGE32 = (WM_USER + 6)
Private Const PBM_GETRANGE = (WM_USER + 7)
Private Const PROGRESS_CLASS = "msctls_progress32"
Private Const PBS_VERTICAL = &H4
Private Const ICC_PROGRESS_CLASS = &H20

Private Type tagINITCOMMONCONTROLSEX
   dwSize As Long
   dwICC As Long
End Type

Private Declare Function InitCommonControlsEx Lib "comctl32.dll" _
   (lpInitCtrls As tagINITCOMMONCONTROLSEX) As Boolean
   
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Private Declare Function CreateWindowEx Lib "user32" _
   Alias "CreateWindowExA" _
  (ByVal dwExStyle As Long, _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String, _
   ByVal dwStyle As Long, _
   ByVal x As Long, ByVal y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal hWndParent As Long, _
   ByVal hMenu As Long, _
   ByVal hInstance As Long, _
   lpParam As Any) As Long

Private Declare Function DestroyWindow Lib "user32" _
   (ByVal hwnd As Long) As Long

Private Declare Function IsWindow Lib "user32" _
  (ByVal hwnd As Long) As Long

Private Declare Function MoveWindow Lib "user32" _
  (ByVal hwnd As Long, _
   ByVal x As Long, _
   ByVal y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal bRepaint As Long) As Long

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 Declare Function GetWindowLong Lib "user32" _
   Alias "GetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
Private Declare Function SetWindowLong Lib "user32" _
   Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long
   
Private Declare Sub CopyMemory Lib "kernel32" _
   Alias "RtlMoveMemory" _
  (Destination As Any, Source As Any, _
   ByVal Length As Long)


Private Sub Form_Load()
  
   Call IsNewComctl32
   
   With Text1
      .Text = 25000
      .Move 1000, 300, 1000, 285
      
      Call SetWindowLong(.hwnd, _
                         GWL_STYLE, _
                         GetWindowLong(Text1.hwnd, GWL_STYLE) _
                         Or ES_NUMBER)
   End With
   
   With Check1
      .Caption = "Vertical"
      .Value = vbUnchecked
      .Move 2200, 300, 1200, 285
   End With
     
   With Command1
      .Caption = "Create && Run ProgressBar..."
      .Cancel = True
      .Move 1000, 700, 2500, 375
   End With
  
   With Label1
      .AutoSize = True
      .WordWrap = False
      .Caption = ""
      .Move 900, 1200
   End With
   
   With Label2
      .AutoSize = True
      .WordWrap = False
      .Caption = "n %"
      .Move 3700, 780 ', 2500, 375
   End With
   
   Me.ScaleMode = vbPixels
   
End Sub


Private Sub Form_Resize()
  
  'adjust the width & height w/the form
   If IsWindow(hProgBar) Then
   
      MoveWindow hProgBar, _
                 dwPBPosLeft, dwPBPosTop, _
                 Me.ScaleWidth - dwPBPosLeft, _
                 Me.ScaleHeight - dwPBPosTop, _
                 1
    
   'display the progress bar's current size
    Label1.Caption = "Width: " & Me.ScaleWidth - dwPBPosLeft & _
                     "   Height: " & Me.ScaleHeight - dwPBPosTop & _
                     "   (pixels)"
  Else
  
    Label1.Caption = "(click button to create a progress bar...)"
    
  End If

End Sub


Private Sub Command1_Click()
  
  'Dynamically create a progress bar and place it at the
  'bottom (or the right) of the form, do stuff that takes a
  'while & show the progress, then destroy the progress bar.
  
  '(The progress bar could be hidden using ShowWindow() instead
  'of it being destroyed, but the time it takes to create it is
  'negligible & its resources are also freed with this method)
   Static bRunning As Boolean   'cancel flag
   Dim bIsIE3 As Boolean
   Dim dwIterations As Long
   Dim dwRange As Long
   Dim dwStyle As Long
   Dim cnt As Long
   
   On Local Error GoTo progbar_exit
   
   If bRunning Then bRunning = False: Exit Sub
         
  'Set the default progress bar styles
   dwStyle = WS_CHILD Or WS_VISIBLE
   
  'if vertical selected, make it so!
   If Check1.Value = vbChecked Then
      dwStyle = dwStyle Or PBS_VERTICAL
   End If
  
  'Create and show the status bar. Additional standard
  'or extended window styles can be specified to alter the
  'default appearance of the progress bar. The progress
  'bar can also be easily created as a child window of a
  'status bar part (VB "Panel"). Substitute the status bar's
  'hWnd and a part's bounding rectangle (via SB_GETRECT) in
  'CreateWindowEx()'s respective params below.
   hProgBar = CreateWindowEx(0, PROGRESS_CLASS, _
                             vbNullString, _
                             dwStyle, _
                             0, 0, 0, 0, _
                             hwnd, 0, _
                             App.hInstance, _
                             ByVal 0)
  
   If hProgBar = 0 Then MsgBox "CreateWindowEx failed.": Exit Sub
     
  'Here we go... the progress bar's style can't
  'be changed after its been created.
   bRunning = True
   Command1.Caption = "Stop"
   Text1.Enabled = False
   Check1.Enabled = False

  'Set the progress bar's static x (or y) position
  'so its initially 20 pixels wide (or high). The code
  'in the form_resize event uses these values to position
  'the progress bar
   If Check1.Value = vbChecked Then
      dwPBPosLeft = Me.ScaleWidth - 20
      dwPBPosTop = 0
   Else
      dwPBPosTop = Me.ScaleHeight - 20
      dwPBPosLeft = 0
   End If
  
  'MoveWindow() in the Form_Resize event will set the
  'progress bar's initial position & size. It will also
  'display the prog bar's current size in the label.
   Call Form_Resize
  
  'get the number of iterations entered into the textbox
   dwIterations = Val(Text1.Text)
   
  'set the range and step interval of the progress bar
   dwRange = MAKELPARAM(0, dwIterations)
   Call SendMessage(hProgBar, PBM_SETRANGE, 0&, ByVal dwRange)
   Call SendMessage(hProgBar, PBM_SETSTEP, ByVal 1, 0&)
  
  'Let's do some stuff...
   For cnt = 1 To dwIterations
  
     'call DoEvents to allow the loop to
     'respond to a cancel (stop) command
      DoEvents
      If Not bRunning Then Exit For
      
     '<your app-specific code goes here>
        
     'advance the current position of the progress bar
     'by the step increment.
      Call SendMessage(hProgBar, PBM_STEPIT, 0&, ByVal 0&)
      Label2.Caption = Int((cnt / dwIterations) * 100) & " %"
    
   Next

progbar_exit:

  'Free all resources associated with the progress bar.
  'If not destroyed here, the progress bar will automatically
  'be destroyed when the parent window - the window specified in
  'hWndParent of CreateWindowEx() - is destroyed.
   If IsWindow(hProgBar) Then Call DestroyWindow(hProgBar)
  
  're-initialize form's controls
   bRunning = False
   Command1.Caption = "Create && Run ProgressBar..."
   Text1.Enabled = True
   Check1.Enabled = True
   Label2.Caption = "n %"

End Sub


Private Function MAKELPARAM(wLow As Long, wHigh As Long) As Long

  'Combines two integers into a long
   MAKELPARAM = MAKELONG(wLow, wHigh)
  
End Function


Private Function MAKELONG(wLow As Long, wHigh As Long) As Long

   MAKELONG = LoWord(wLow) Or (&H10000 * LoWord(wHigh))
  
End Function


Private Function LoWord(dwValue As Long) As Integer

   CopyMemory LoWord, dwValue, 2
  
End Function


Private Function IsNewComctl32() As Boolean

  'ensures that the Comctl32.dll library is loaded
   Dim icc As tagINITCOMMONCONTROLSEX
   
   On Error GoTo Err_InitOldVersion
   
   icc.dwSize = Len(icc)
   icc.dwICC = ICC_PROGRESS_CLASS
   
  'VB will generate error 453 "Specified DLL function not found"
  'here if the new version isn't installed
   IsNewComctl32 = InitCommonControlsEx(icc)
   
   Exit Function
   
Err_InitOldVersion:
   InitCommonControls
   
End Function

Comments

Save then run the project, enter the number of iterations to execute (maximum 32k) and click the command button.

If, in testing just the progress bar, this code runs the bar too fast for you to debug, add a declaration for the Sleep API to the form and add a Sleep call in the loop to simulate the time taken to process your application data. When simulating 100 to 500 files 100 milliseconds should be enough for you to see the effect. If simulating less than 100 files up the delay to 200 or 250. If simulating more than 500 or so files, decrease it as low as 10 or you'll spend all day watching it.

PayPal Link