 There
seems to be considerable interest in a method to automatically centre a label within a container control who's text is of varying length both
horizontally and vertically. The CentreLabelText routine, by manipulating the label's WordWrap and AutoSize properties, does just this. The
routine is defined as a function, and its return value, if interested, contains the number of lines that the label required to display the
text. This code is not required for the CentreLabelText to function, but provided as additional functionality. Not provided in this code
however is any additional code that might be required to change the width of the label to accommodate a text string who's height may exceed
the default height of the current container. The routine uses the label width initially established at design time.
To demonstrate the code, the demo uses a label within a frame
container to display one of four messages, each of which has a different length. Note that any container object - including a form - could be
used instead of a frame by just changing the Frame1 references. The frame border can be visible or hidden; its show visible here for
illustration.
Purely for demonstration purposes, the code toggling between the four
messages is being called from within a timer routine; doing such removes the need to press a button to change the text in order to see the
routine work. The method does not rely on or require the timer, and by including just the CentreLabelText method (and possibly another
routine to populate the Label caption, if needed), it is fully portable between applications. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Load()
Timer1.Enabled = False
End Sub
Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
Timer1.Interval = 1000
Command1.Caption = IIf(Timer1.Enabled, "Stop", "Select Messages")
End Sub
Private Function CentreLabelText(ctl As Label) As Long
'----------------------------------------------------
'Centres a label within its frame
'whose text length may vary
'Turn off AutoSize before setting WordWrap
ctl.AutoSize = False
ctl.WordWrap = True
'Get a message of varying length to test
ctl.Caption = GetLabelMessage()
'Turn AutoSize back on to ensure all text
'is displayed in the label (not cropped at
'the bottom)
ctl.AutoSize = True
'Position the label within the frame
ctl.Move (Frame1.Width - ctl.Width) \ 2, (Frame1.Height - ctl.Height) \ 2
'----------------------------------------------------
'This portion shows how to calculate
'the number of lines in the label. It is
'not required for the above example to work).
Dim onelineheight As Long
'Assign the label's font properties
'to the form
Form1.Font = Label1.Font
Form1.Font.Bold = Label1.Font.Bold
'Get the height of a text item...
onelineheight = Form1.TextHeight("A")
'..and just divide
CentreLabelText = Label1.Height \ onelineheight
End Function
Private Function GetLabelMessage() As String
'toggle one of 4 messages of varying length
Static x As Long
Dim msg As String
x = x + 1
If x = 5 Then x = 1
Select Case x
Case 1
msg = "and so man was the first to encounter the strange "
msg = msg & "behaviour of the female species, and not to his benefit."
Case 2
msg = "and so man was the first to encounter the "
msg = msg & "strange behaviour of the female species, and not "
msg = msg & "to his benefit. and so man was the first to encounter "
msg = msg & "the strange behaviour of the female species, and not to his benefit."
Case 3
msg = "and so man was the first to encounter the strange ...."
Case 4
msg = "With two exceptions you cannot use SHFileOperation to "
msg = msg & "move special folders from a local drive to a remote computer "
msg = msg & "by specifying a network path - MyDocs and MyPics "
msg = msg & "(CSIDL_PERSONAL and CSIDL_MYPICTURES). When used to "
msg = msg & "delete a file, SHFileOperation will attempt to place the "
msg = msg & "deleted file in the recycle bin. Use DeleteFile to "
msg = msg & "guarantee a file will not be placed in the recycle bin."
Case Else
msg = "Oops! Something's wrong here."
End Select
GetLabelMessage = msg
End Function
Private Sub Timer1_Timer()
'The timer is only used to change the text for demo and
'is not required in the final routine. The return value
'-- the number of lines needed to display the centred
'text, is returned to the text box.
Text1.Text = CentreLabelText(Label1)
End Sub |
