Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Visual Basic 6 add backcolor to statusbar panel

Tags:

vb6

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.

like image 317
wadefanyaoxia Avatar asked Nov 15 '19 18:11

wadefanyaoxia


Video Answer


1 Answers

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
like image 75
Brian M Stafford Avatar answered Sep 24 '22 00:09

Brian M Stafford