VB and VBA Users Source Code: Adding custom text in a Statusbar pannel (inc. setting backcolor)
[
Home
|
Contents
|
Search
|
Reply
| Previous |
Next
]
VB/VBA Source Code
Adding custom text in a Statusbar pannel (inc. setting backcolor)
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, May 10, 2001
Hits:
1304
Category:
Windows API
Article:
The following code demonstrates how to set the font, backcolor, forecolor and alignment of the text inside a statusbar pannel. Option Explicit 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 Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type 'Purpose : Puts custom text on a status bar panel 'Inputs : sbSetText The status bar to place the caption on ' lPanelIndex The panel to place the the text on. ' sText The text to place on the panel. ' lBackColor The backcolor of the panel ' lForeColor The forecolor of the panel ' [tAlignText] The horizontal text alignment (defaults to left) ' [oFont] The font to set the text to (defaults to panel font) 'Outputs : Returns True on success 'Author : Andrew Baker 'Date : 25/03/2000 'Notes : The text in the panel will appear in the font that that Statusbar was ' using at the time of calling this function Function PanelSetText(sbSetText As StatusBar, lPanelIndex As Long, sText As String, lBackColor As Long, lForeColor As Long, optional tAlignText As AlignConstants=vbAlignLeft , Optional oFont As StdFont) As Boolean Const WM_USER = &H400, SB_GETRECT = (WM_USER + 10), clBorder As Long = 0 Dim tRect As RECT Static oPict As PictureBox On Error GoTo ErrFailed If oPict Is Nothing Then 'Create a hidden image on the form Set oPict = sbSetText.Parent.Controls.Add("VB.PictureBox", "DynamicPictureBox") oPict.AutoRedraw = True End If 'Set panels text (for autosizing) sbSetText.Panels(lPanelIndex).Text = sText 'Clear picture (for autosizing) Set sbSetText.Panels(lPanelIndex).Picture = Nothing 'Get the panel coordinates SendMessage sbSetText.hwnd, SB_GETRECT, lPanelIndex - 1, tRect 'Clear text sbSetText.Panels(lPanelIndex).Text = "" With oPict 'Set the panel of the image If oFont Is Nothing Then Set .Font = sbSetText.font Else Set .Font = oFont End If 'Resize image .Move 0, 0, (tRect.Right - tRect.left + 2) * Screen.TwipsPerPixelX, (tRect.Bottom - tRect.Top + 1) * Screen.TwipsPerPixelY 'Set the image backcolor .backcolor = lBackColor 'Clear the existing text .Cls .forecolor = lForeColor 'Align vertically in center .CurrentY = (.Height - .textheight(sText)) \ 2 Select Case tAlignText Case vbAlignLeft .currentx = clBorder Case vbAlignRight ' Right Justified .currentx = .width - .TextWidth(sText) - clBorder - Screen.TwipsPerPixelX * 4 Case Else ' Centered .currentx = (.width - .TextWidth(sText)) \ 2 End Select 'Set the picture box width and print text on picture box .width = .TextWidth(sText) + 75 oPict.Print sText 'Set the panels image to the picture box image sbSetText.Panels(lPanelIndex).AutoSize = sbrNoAutoSize sbSetText.Panels(lPanelIndex).width = .TextWidth(sText) + 75 Set sbSetText.Panels(lPanelIndex).Picture = .Image End With PanelSetText = True Exit Function ErrFailed: Debug.Print err.description Debug.Assert False PanelSetText = False End Function 'Demonstration routine Private Sub Form_Load() 'Set the text of the first pannel in the statusbar StatusBar1.Font.Size = 10 StatusBar1.Font.Bold = True PanelSetText StatusBar1, 1, "Custom Text", vbBlue, vbRed, vbAlignLeft 'Set the text of the second pannel in the statusbar StatusBar1.Font.Size = 12 StatusBar1.Font.Name = "Arial" PanelSetText StatusBar1, 2, "Hello", vbGreen, vbYellow, vbAlignRight End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
