Visual Basic 6向状态栏面板添加背景色

Question

我正在修复一个基于Visual Basic 6代码的旧应用程序。要求在表单底部添加状态栏。我的状态栏如下：

我可以正确显示文本，但我也想添加红色背景色。我发现StatusBar面板没有这样的选项。当我打开StatusBar的属性时，它显示如下：

我发现我可以添加图片。但是当我添加红色图片时，文字将被图片覆盖。我被困住了。任何建议都会有所帮助。谢谢！！

更新

我只是使用了注释中提供的@ÉtienneLaneville链接中的代码。添加了背景色和文本。

这是我调用该函数的代码：

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

但是文本位置如下：

我必须像下面这样放置文本才能定位它，因为此任务目前很紧急，我没有时间进行更多研究。

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

以下是我的输出：

更新2

我尝试了Brian M Stafford提供的代码。但是我得到了相同的结果。文本仍不在中心（或向左）。以下是我的代码和状态栏的屏幕截图：

功能：

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

调用函数：

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

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

我不知道为什么。可能是我错过了一些事情，或者是我将某些属性值设置为StatusBar1或picPanel（PictureBox）。

解

我设置pictureBox，属性AutoRedraw = True，并设置StatusBar，Panel，Alignment = sbrLeft。一切正常。

Answer 1

以下是评论中引用的代码，并进行了一些增强。一项增强功能是指定文本对齐方式的参数：

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

下面是 Windows API 代码：

    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)

然后使用代码如下：

    Picture2.AutoRedraw = True
    Picture2.Visible = False

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