Visual Basic Programming Code Examples

Visual Basic > Forms Code Examples

Adding custom text in a Statusbar pannel (inc. setting backcolor)



Adding custom text in a Statusbar pannel (inc. setting backcolor)

The following code demonstrates how to set the font, backcolor, forecolor and alignment of the text inside a statusbar pannel.

Option Explicit

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 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


'Purpose   :    Puts custom text on a status bar panel
'Inputs    :    sbSetText               The status bar to place the caption on
'               lPanelIndex             The panel to place the the text on.
'               sText                   The text to place on the panel.
'               lBackColor              The backcolor of the panel
'               lForeColor              The forecolor of the panel
'               [tAlignText]            The horizontal text alignment (defaults to left)
'               [oFont]                 The font to set the text to (defaults to panel font)
'Outputs   :    Returns True on success
'Notes     :    The text in the panel will appear in the font that that Statusbar was
'               using at the time of calling this function

Function PanelSetText(sbSetText As StatusBar, lPanelIndex As Long, sText As String, lBackColor As Long, lForeColor As Long, optional tAlignText As AlignConstants=vbAlignLeft , Optional oFont As StdFont) As Boolean

    Const WM_USER = &H400, SB_GETRECT = (WM_USER + 10), clBorder As Long = 0
    Dim tRect As RECT
    Static oPict As PictureBox
    
    On Error GoTo ErrFailed
    If oPict Is Nothing Then
        'Create a hidden image on the form
        Set oPict = sbSetText.Parent.Controls.Add("VB.PictureBox", "DynamicPictureBox")
        oPict.AutoRedraw = True
    End If

    'Set panels text (for autosizing)
    sbSetText.Panels(lPanelIndex).Text = sText
    'Clear picture (for autosizing)
    Set sbSetText.Panels(lPanelIndex).Picture = Nothing
    'Get the panel coordinates
    SendMessage sbSetText.hwnd, SB_GETRECT, lPanelIndex - 1, tRect
    'Clear text
    sbSetText.Panels(lPanelIndex).Text = ""

    With oPict
        'Set the panel of the image
        If oFont Is Nothing Then
            Set .Font = sbSetText.font
        Else
            Set .Font = oFont
        End If
        'Resize image
        .Move 0, 0, (tRect.Right - tRect.left + 2) * Screen.TwipsPerPixelX, (tRect.Bottom - tRect.Top + 1) * Screen.TwipsPerPixelY
        'Set the image backcolor
        .backcolor = lBackColor
        'Clear the existing text
        .Cls
        .forecolor = lForeColor
        'Align vertically in center
        .CurrentY = (.Height - .textheight(sText)) \ 2

        Select Case tAlignText
        Case vbAlignLeft
            .currentx = clBorder
        Case vbAlignRight      ' Right Justified
            .currentx = .width - .TextWidth(sText) - clBorder - Screen.TwipsPerPixelX * 4
        Case Else      ' Centered
            .currentx = (.width - .TextWidth(sText)) \ 2
        End Select

        'Set the picture box width and print text on picture box
        .width = .TextWidth(sText) + 75
        oPict.Print sText

        'Set the panels image to the picture box image
        sbSetText.Panels(lPanelIndex).AutoSize = sbrNoAutoSize
        sbSetText.Panels(lPanelIndex).width = .TextWidth(sText) + 75
        Set sbSetText.Panels(lPanelIndex).Picture = .Image
    End With

    PanelSetText = True
    Exit Function

ErrFailed:
    Debug.Print err.description
    Debug.Assert False
    PanelSetText = False
End Function

'Demonstration routine
Private Sub Form_Load()

    'Set the text of the first pannel in the statusbar
    StatusBar1.Font.Size = 10
    StatusBar1.Font.Bold = True
    PanelSetText StatusBar1, 1, "Custom Text", vbBlue, vbRed, vbAlignLeft

    'Set the text of the second pannel in the statusbar
    StatusBar1.Font.Size = 12
    StatusBar1.Font.Name = "Arial"
    PanelSetText StatusBar1, 2, "Hello", vbGreen, vbYellow, vbAlignRight
End Sub