Search code examples
vb6

Visual Basic 6 add backcolor to statusbar panel


I am fixing an old application which built on top of Visual Basic 6 code. There is an requirement that adding a statusbar on the bottom of the form. My status bar is as below:

enter image description here

I can show the text correctly but I also want to add a red background color. I found out there is no such option for StatusBar Panel. When I open the property of StatusBar, it shows as below:

enter image description here

I found out I can add picture. But When I added the red color picture, the text will be cover by the picture. I am stuck. Any advice will be helpful. Thanks!!

UPDATE

I simply used the code from the link @Étienne Laneville provided in the comment. The background color added and also the text added.

Here is my code to call the function:

    PanelText StatusBar1, 9, "ATM (" & cntATM & ")", QBColor(12), QBColor(0)

But the text position is like below:

enter image description here

I have to make the text like below to position it, because this task was urgent for now and I have no time to investigate more.

    PanelText StatusBar1, 9, "ATM (" & cntATM & ")                           ", QBColor(12), QBColor(0)

Below is my output:

enter image description here

UPDATE 2

I tried the code provided by Brian M Stafford. But I got the same results. The text is still not at the center (Or to the Left). Below are my code and screenshot of status bar:

enter image description here

The function:

Private Sub PanelText(sb As StatusBar, pic As PictureBox, Index As Long, aText As String, bkColor As Long, _
    fgColor As Long, lAlign As Integer)

    Dim R As RECT

    SendMessage sb.hWnd, SB_GETRECT, Index - 1, R
    With pic
        Set .Font = sb.Font
        .Move 0, 0, (R.Right - R.Left + 2) * Screen.TwipsPerPixelX, (R.Bottom - R.Top) * Screen.TwipsPerPixelY
        .BackColor = bkColor
        .Cls
        .ForeColor = fgColor
        .CurrentY = (.Height - .TextHeight(aText)) \ 2

        Select Case lAlign
            Case 0      ' Left Justified
                .CurrentX = 0
            Case 1      ' Right Justified
                .CurrentX = .Width - .TextWidth(aText) - Screen.TwipsPerPixelX * 2
            Case 2      ' Centered
                .CurrentX = (.Width - .TextWidth(aText)) \ 2
        End Select

        pic.Print aText
        sb.Panels(Index).Text = aText
        sb.Panels(Index).Picture = .Image
    End With
End Sub

The API:

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const WM_USER = &H400
Private Const SB_GETRECT = (WM_USER + 10)

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

Calling the function:

PanelText StatusBar1, picPanel, 9, "Test1", vbRed, vbBlack, 2

PanelText StatusBar1, picPanel, 10, "DFM (" & cntDFM & ")", vbRed, vbBlack, 2

I do not know why. May be I missed something or may be I set some property values to the StatusBar1 or picPanel(PictureBox).

SOLUTION

I set pictureBox, property AutoRedraw = True, and StatusBar, Panel, Alignment = sbrLeft. And everything works.


Solution

  • Here's the code referenced in a comment with some enhancements. One enhancement is a parameter to specify text alignment:

    Private Sub StatusBarPanelText(sb As StatusBar, pic As PictureBox, index As Long, aText As String, bkColor As Long, fgColor As Long, lAlign As Integer)
        Dim r As RECT
    
        SendMessage sb.hWnd, SB_GETRECT, index - 1, r
    
        With pic
            Set .Font = sb.Font
            .Move 0, 0, (r.Right - r.Left + 2) * Screen.TwipsPerPixelX, (r.Bottom - r.Top) * Screen.TwipsPerPixelY
            .BackColor = bkColor
            .Cls
            .ForeColor = fgColor
            .CurrentY = (.Height - .TextHeight(aText)) \ 2
    
            Select Case lAlign
                Case 0      ' Left Justified
                    .CurrentX = 0
                Case 1      ' Right Justified
                    .CurrentX = .Width - .TextWidth(aText) - Screen.TwipsPerPixelX * 2
                Case 2      ' Centered
                    .CurrentX = (.Width - .TextWidth(aText)) \ 2
            End Select
    
            pic.Print aText
            sb.Panels(index).Text = aText
            sb.Panels(index).Picture = .Image
        End With
    End Sub
    

    Here's the Windows API code:

        Private Type RECT
           Left As Long
           Top As Long
           Right As Long
           Bottom As Long
        End Type
    
        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 Const WM_USER = &H400
        Private Const SB_GETRECT = (WM_USER + 10)
    

    The code is then used like this:

        Picture2.AutoRedraw = True
        Picture2.Visible = False
    
        StatusBarPanelText sbConfig, Picture2, 4, & _
           Format(Value / 1024, "#,###") & " KB", vbRed, vbWhite, 0