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 

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