Visual Basic 6 thêm backcolor vào bảng thanh trạng thái

Tôi đang sửa một ứng dụng cũ được xây dựng dựa trên mã Visual Basic 6. Có một yêu cầu là thêm một thanh trạng thái ở dưới cùng của biểu mẫu. Thanh trạng thái của tôi là như sau:

Tôi có thể hiển thị văn bản chính xác nhưng tôi cũng muốn thêm màu nền đỏ. Tôi phát hiện ra rằng không có tùy chọn như vậy cho Bảng điều khiển StatusBar. Khi tôi mở thuộc tính của StatusBar, nó hiển thị như bên dưới:

Tôi phát hiện ra tôi có thể thêm hình ảnh. Nhưng khi tôi thêm hình ảnh màu đỏ, văn bản sẽ được bao phủ bởi hình ảnh. Tôi bị mắc kẹt. Bất kỳ lời khuyên sẽ hữu ích. Cảm ơn!!

CẬP NHẬT

Tôi chỉ đơn giản là sử dụng mã từ liên kết @ Étienne Laneville được cung cấp trong bình luận . Màu nền được thêm vào và cả văn bản được thêm vào.

Đây là mã của tôi để gọi hàm:

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

Nhưng vị trí văn bản như dưới đây:

Tôi phải làm cho văn bản như dưới đây để định vị nó, bởi vì nhiệm vụ này là khẩn cấp và tôi không có thời gian để điều tra thêm.

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

Dưới đây là đầu ra của tôi:

CẬP NHẬT 2

Tôi đã thử mã được cung cấp bởi Brian M Stafford. Nhưng tôi đã nhận được kết quả tương tự. Văn bản vẫn không ở trung tâm (Hoặc bên trái). Dưới đây là mã và ảnh chụp màn hình của thanh trạng thái:

Chức năng:

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

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

Gọi hàm:

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

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

Tôi không biết tại sao. Có thể tôi đã bỏ lỡ điều gì đó hoặc có thể tôi đặt một số giá trị thuộc tính thành StatusBar1 hoặc picPanel (PictureBox).

GIẢI PHÁP

Tôi đặt imageBox, thuộc tính AutoRedraw = True và StatusBar, Panel, AlVEL = sbrLeft. Và mọi thứ hoạt động.

Đây là mã được tham chiếu trong một bình luận với một số cải tiến. Một cải tiến là một tham số để chỉ định căn chỉnh văn bản:

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

Đây là mã API Windows:

    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)

Mã này sau đó được sử dụng như thế này:

    Picture2.AutoRedraw = True
    Picture2.Visible = False

    StatusBarPanelText sbConfig, Picture2, 4, & _
       Format(Value / 1024, "#,###") & " KB", vbRed, vbWhite, 0