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

Visual Basic 6 add backcolor to statusbar panel

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

我可以正确显示文本,但我还想添加红色背景色。我发现状态栏面板没有这样的选项。当我打开 StatusBar 的 属性 时,显示如下:

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

更新

我只是使用了 comment 中提供的 link @Étienne Laneville 的代码。添加了背景颜色并添加了文本。

这是我调用函数的代码:

    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。一切正常。

这是代码 referenced in a comment 并进行了一些改进。一项增强功能是指定文本对齐方式的参数:

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

我知道我来晚了,这个特殊问题可能不再重要,但我还是来了。在尝试为从 W-95 开始的所有 Windows 版本编写 VB6 程序时,我 运行 遇到了一些与 Microsoft 决定更改 Windows 后续版本的命名配色方案相关的颜色问题.我发现使用安装了 Windows-98 和 VB6 的虚拟机我可以在本地更改状态栏的背景颜色。 属性 在使用 Win-98 而非 XP 及更高版本时位于“属性”框中。我猜雷德蒙德的男孩们想在我们的作品中强加他们的风格,所以取消了这个选择。我知道这不是一个完美的解决方案,但它可能是您可以接受的。

抱歉,这是我的错误。当我将文件从 Win-7 复制到 Win-98 时,VB6 将状态栏控件替换为图片框并将其命名为 statusbar1。我不确定为什么,因为选中了公共控件选项并且状态栏出现在工具箱中。看起来上面的解决方案是有效的,而我的不是。