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:
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:
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:
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:
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:
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.
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
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With