Visual Basic 6でステータスバーパネルに背景色を追加

Visual Basic 6コードの上に構築された古いアプリケーションを修正しています。フォームの下部にステータスバーを追加する必要があります。私のステータスバーは以下の通りです：

テキストは正しく表示できますが、背景色を赤にしたいです。StatusBar Panelにはそのようなオプションがないことがわかりました。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を設定します。そして、すべてが機能します。

これは、コメントで参照されているコードで、いくつかの機能強化が行われています。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