Visual Basic Common Control API Routines
CreateStatusWindow: The Common Control Status Bar via API
     
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:  

InitCommonControlsEx: Common Control Initialization Module
CreateStatusWindow: The Common Control Status Bar via API - Overview
     
 Prerequisites
This project requires the BAS modules constructed in the accompanying articles:

    InitCommonControlsEx: Common Control Initialization Module
    Creating the Common Control Status Bar via the API - An Overview


vbnsCCStatBarSimple.gif (5814 bytes)In this second article written for VBnet by Brad Martinez, Brad works out the magic behind the Win32 Status Bar common control (window) exposed by the common control library Comctl32.dll without the use of Comctl32.ocx. Subsequent pages will introduce more functionality in creating the control.

The advantages of this implementation are beneficial. First and foremost, any method that may reduce the need to distribute Comctl32.ocx with an application warrants examination. The size of the distributed app is reduced as is its memory footprint by not loading an ActiveX control. Finally, there is a noticeable improvement in performance.

This page will deal with providing the basic functionality to create and display the status bar in your own apps, simplified from Brad's full version to provide an easier means of grasping the concepts required to implement this control in VB.
 BAS Module Code
Begin a new VB4-32 or VB5 project and add in both the BAS module 'InitCC.bas' from the initialization page and the BAS module from the Status Bar Overview page. Add a third BAS module (CommonStatusRoutines.bas) to the project and place the following API declare code into the general declarations area:

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.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function DestroyWindow Lib "user32" _
  (ByVal hwnd As Long) As Long

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

Public 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

Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   wParam As Any, _
   lParam As Any) As Long

'The data type for lpRect was changed from "As RECT" to
'"As Any" to allow a null pointer to be passed (i.e. ByRef 0)
'BTW the RECT structure is declared in MStatusDefs
Public Declare Function InvalidateRect Lib "user32" _
  (ByVal hWnd As Long, _
   lpRect As Any, _
   ByVal bErase As Long) As Long

Public Declare Function GetWindowRect Lib "user32" _
  (ByVal hWnd As Long, _
   lpRect As RECT) As Long


Public Function GetParts(hStatBar As Long) As Integer
   'Returns the current number of existing parts in the status bar.
   'The SB_GETPARTS message also retrieve individual part
   'information. See the comments in Status.bas for more info.

  GetParts = SendMessage(hStatBar, SB_GETPARTS, 0, ByVal 0)
  
End Function


Public Sub SetText(hStatBar As Long, _
                   bPart As Byte, _
                   wNewDrawOp As Integer, _
                   sText As String)
  
   'Sets the specified part's text.
  '
  'bPart:zero-based part to set, 255 = simple mode text.
  'wNewDrawOp:text drawing operation.
  'sText:text to set

   Dim wCurDrawOp As Integer

   'Get the part's current drawing operation
   'before it might be updated below.
   wCurDrawOp = GetCurDrawOp(hStatBar, bPart, False)

   'Set the text w/ the drawing operation
   SendMessage hStatBar, SB_SETTEXT, ByVal bPart Or wNewDrawOp, ByVal sText
  
   'Redraw the status bar only if the part's drawing
   'operation changed (reduces flicker).
   If wCurDrawOp <> wNewDrawOp Then InvalidateRect hStatBar, ByVal 0, True
  
End Sub


Public Function GetCurDrawOp(hStatBar As Long, _
                             bPart As Byte, _
                             fRtnString As Boolean) As String
  
   'Returns the current text drawing operation for the specified part.
   '
   'SB_GETTEXTLENGTH is used to determine the part's current
   'drawing operation. SB_GETTEXT will rtn the exact same value,
   'but requires a text buffer.
   '
   'When not in simple mode, SB_GETTEXTLENGTH  retrieves the
   'text length for the part specified by bPart (0-254, 255 parts max).
   'If in simple mode, SB_GETTEXTLENGTH will retrieve the simple
   'mode text length *only* if bPart specifies any *valid* part index.
   'The simple mode text length is NOT retrieved when bPart = 255
   '(as is used to set text w/ SB_SETTEXT). Also applies to
   'SB_GETTEXT.
   '
   'If fRtnString = True, returns the text drawing operation constant
   'string. If False, returns the text drawing operation constant value.

   Dim dwRtn As Long

   dwRtn = SendMessage(hStatBar, SB_GETTEXTLENGTH, ByVal bPart, 0)

   'The text drawing operation for the specified
   'part is contained in the high word of dwRtn.
   dwRtn = (dwRtn And &HFFFF0000) \ &HFFFF&

   If fRtnString Then

     'Returning the string
      Select Case dwRtn
         Case SBT_SUNKEN:    GetCurDrawOp = "SBT_SUNKEN"
         Case SBT_NOBORDERS: GetCurDrawOp = "SBT_NOBORDERS"
         Case SBT_POPOUT:    GetCurDrawOp = "SBT_POPOUT"
      End Select

   Else

     'Returning the value
      GetCurDrawOp = dwRtn
  
     End If
End Function


Public Sub SetParts(frm As Form, hStatBar As Long, bParts As Byte) '1-255 max!

   'Sets the specified number of status bar parts.
  'Any existing part with a greater index than the number of parts
  'specified by bParts is destroyed, i.e 8 existing parts (0-7), 6 is
  'specified for bParts, the last 2 parts (6 & 7) are destroyed.

  'Array is zero based, will error back to
  'cmdDoMsgs_Click() if 0 is passed.

   ReDim adwParts(bParts - 1) As Long
   Dim bPart As Byte

  'Set all but the last part so they have an equal width.
   For bPart = 1 To bParts - 1
     adwParts(bPart - 1) = (frm.ScaleWidth \ bParts) * bPart
   Next

  'Last part uses remaining real estate & extends to right edge.
   adwParts(bParts - 1) = -1
  
   SendMessage hStatBar, SB_SETPARTS, ByVal bParts, adwParts(0)
  
End Sub 
 Form Code
Create a new form, and add the following controls:
    text box          Text1
    text box          Text2
    8 check boxes     Check1(0) - Check1(7)
    check box         Check2
    command button    Command1
    command button    Command2
    command button    Command3
    command button    Command4
    command button    Command4 

Add the following to the general declarations section of the form:


Option Explicit

'mode flag used in case fIsNewComctl = False
'and status bar handle
Dim fIsNewComctl As Boolean
Dim hStatBar As Long


Private Sub Form_Load()
   
  'Rtns true & sets the flag if we have the new version
  'of Comctl32.dll.   
   fIsNewComctl = InitComctl32(ICC_BAR_CLASSES)
  
   Move (Screen.Width - Width) * 0.5, (Screen.Height - Height) * 0.5
   
  'We need pixels to for some of the msgs.   
   ScaleMode = vbPixels
   
  'Enable controls accordingly.   
   EnableCtrls False

End Sub


   
Private Sub Command1_Click()

  'Brings a brand new status bar into the world... 
   Dim adwParts(1) As Long
   
  'Creates a status bar. The specified text is placed in
  'the one and only part (aka Comctl32.ocx "Panel").
  'Is a bit simpler to call than CreateWindowEx()...   
   hStatBar = CreateStatusWindow(GetStyles(), "A status bar...", Me.hWnd, 0)
  
   If hStatBar Then
   
     'When the status bar is created, it will automatically set its
     'own size & position, *unless* either the CCS_NORESIZE
     'or CCS_NOPARENTALIGN styles are specified. We won't
     'bother checking the styles...   
      MoveWindow hStatBar, 0, ScaleHeight - 20, ScaleWidth, 20, True
   
     'We'll initially create a status bar with 2 "parts". The 1st is 100
     'pixels less than the width of the status bar, the 2nd is 100
     'pixels wide & extends to the right edge of the status bar.
     '(the SetParts() proc way below doesn't provide for setting
     'individual part widths)   
      adwParts(0) = ScaleWidth - 100
      adwParts(1) = -1
   
     'wParam = number of parts
     'lParam = part position array, 0 based   
      If SendMessage(hStatBar, SB_SETPARTS, ByVal 2, adwParts(0)) Then
   
        'We'll set the status bar's 2nd panel text now. 
        'Each part stores its own text, independent of other parts' text.
        'The text is shown when the part is displayed.   
         SetText hStatBar, 1, SBT_SUNKEN, "panel 2"
      End If
   
     'Enables all controls accordingly   
      EnableCtrls True
    
  Else
     MsgBox "Uh oh..."
  End If

End Sub


Private Sub EnableCtrls(fEnable As Boolean)

  'Enables/Disables all controls, with the exception of the
  '"Text drawing operation" ctrls, per the fEnable flag.   

   Dim cnt As Integer
     
  'Style checkboxes   
   For cnt = 2 To 7
      Check1(cnt).Enabled = Not fEnable
   Next
   
   Command1.Enabled = Not fEnable
   Command2.Enabled = fEnable
   Command3.Enabled = fEnable
   Command4.Enabled = fEnable
   Command4.Enabled = True
      
End Sub


Private Function GetStyles() As Long

  'Returns the styles from the selected "Styles" checkboxes.
  '
  'Certain styles act differently when OR'd w/ other styles,
  'producing interesting status bar behavior.   

  Dim dwRtn As Long
  
  If Check1(0) Then dwRtn = dwRtn Or WS_VISIBLE
  If Check1(1) Then dwRtn = dwRtn Or WS_CHILD
  If Check1(2) Then dwRtn = dwRtn Or SBARS_SIZEGRIP
  If Check1(3) Then dwRtn = dwRtn Or CCS_TOP
  If Check1(4) Then dwRtn = dwRtn Or CCS_NOMOVEY
  If Check1(5) Then dwRtn = dwRtn Or CCS_BOTTOM
  If Check1(6) Then dwRtn = dwRtn Or CCS_NORESIZE
  If Check1(7) Then dwRtn = dwRtn Or CCS_NOPARENTALIGN

  GetStyles = dwRtn 

End Function


Private Sub Command2_Click()
  
  'Frees all resources associated with the progress bar &
  'enables all controls accordingly.
  '
  'If it is not destroyed here, the progress bar will automatically
  'be destroyed when its parent window (the window specified in
  'the hWndParent param of CreateStatusWindow()) is destroyed.   

   If IsWindow(hStatBar) Then
      DestroyWindow hStatBar
      hStatBar = 0
      EnableCtrls False
   End If

End Sub


Private Sub Command4_Click()

   SetText hStatBar, 0, SBT_SUNKEN, (Text2.Text)
        
End Sub


Private Sub Command3_Click()

   SetParts Me, hStatBar, Val(Text1.Text)

End Sub


Private Sub Command4_Click()

   If IsWindow(hStatBar) Then DestroyWindow hStatBar
   Unload Me
   
End Sub 
 Comments
Run the project, select options, and hit Create. A default status bar with 2 panels and the text "A status bar" is created. Once it exists, you can set the number of panels displayed, and the text (for panel 1, just to keep the example simple).

 
 

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