We help IT Professionals succeed at work.

Function for calculating variable width font

Medium Priority
Last Modified: 2013-12-03
I wish to write a underline function that can use the indicated character to underline the certain text, eg

This is the example

In this example, the function simply append a carriage return and add 13 "=".

For fixed width font like courier, we know that "This is the example" has 13 characters, we can easily use 13 "=" to underline it.

The problem is for variable width font like Times New Roman. Arial, etc, we cannot be certain that how many "=" we should use in order to underline certain text perfectly.

Is there any written function on the web that can help us to calculate this based on the font type?
(For example, If we input "Times new roman", <font size>, "This is the example", and "=" as parameter to the function, it should return approximately how many "=" should be use based on the length of the text)
(Or, If we input "Times new roman", <font size>, "This is the example"  to the function, the function should return us the length of string based on certain unit, and we use the return information to calculate our own)
(Or even there don't have any function avaialable, but there is a table of the width of font for certain font type, we write the function ourself)
(Or, something that is workable)

Watch Question

Hi william007,
You can use TextWidth function. It is member function of form and it uses font of form as default font.


Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts
Hi william007

Test this, it runs from the paint(Graphics graphics).
Of course this is the soultion if you add the underline from the paint.

FontRenderContext frc;
TextLayout tl;
Graphics2D graphics2D;

//test values
String text ="someValue";
Font font =  new Font("Arial", Font.PLAIN, 12);

graphics2D = (Graphics2D)graphics;
frc = graphics2D.getFontRenderContext();
tl = new TextLayout(text, font, frc);

int textWidth = tl.getBounds().getWidth();

Calculating width based on fonts has always been a bit of a minefield. Try looking at


as I think this may help you, if not then you may need to write your own function that supports it's own factoring

for example...

Shared Function GenerateUnderline(byval OriginalWidth as decimal, byval textLength as integer, byval textFont as font) as Integer

' OriginalWidth as a constant width for 1 charcter (e.g. courier new 10pt font)
' textLength as the number of characters within the string to underline
' textFont is the font being used

Select Case Font.Size
    Case Between 8 and 12
        FactorX = 1.2

    Case Between 12 and 18
        FactorX = 1.5
End Select

Return ((OriginalWidth * FactorX) * textLength)

Head of Software Services
Hi william007,

This may look a bit complicated but does pretty much what you want it to do. If you start a new project and add a command button and picture box then paste this code. Run it and see. (You can change the text / font name / size etc if you like to something else of course). It will display the results in the picture box and tell you what the relative widths are.

Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As POINTAPI) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function MulDiv Lib "kernel32" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Private Const LOGPIXELSY = 90
Private Const CCHFORMNAME = 32
Private Const CCHDEVICENAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Const BITSPIXEL = 12
Private Const LF_FACESIZE = 32

Private Type DEVMODE
       dmDeviceName As String * CCHDEVICENAME
       dmSpecVersion As Integer
       dmDriverVersion As Integer
       dmSize As Integer
       dmDriverExtra As Integer
       dmFields As Long
       dmOrientation As Integer
       dmPaperSize As Integer
       dmPaperLength As Integer
       dmPaperWidth As Integer
       dmScale As Integer
       dmCopies As Integer
       dmDefaultSource As Integer
       dmPrintQuality As Integer
       dmColor As Integer
       dmDuplex As Integer
       dmYResolution As Integer
       dmTTOption As Integer
       dmCollate As Integer
       dmFormName As String * CCHFORMNAME
       dmUnusedPadding As Integer
       dmBitsPerPel As Long
       dmPelsWidth As Long
       dmPelsHeight As Long
       dmDisplayFlags As Long
       dmDisplayFrequency As Long
End Type

Private Type LOGFONT
   lfHeight As Long
   lfWidth As Long
   lfEscapement As Long
   lfOrientation As Long
   lfWeight As Long
   lfItalic As Byte
   lfUnderline As Byte
   lfStrikeOut As Byte
   lfCharSet As Byte
   lfOutPrecision As Byte
   lfClipPrecision As Byte
   lfQuality As Byte
   lfPitchAndFamily As Byte
   lfFaceName(LF_FACESIZE) As Byte
End Type

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Sub Command1_Click()
   Dim TWidth As Long
   Dim THeight As Long
   Dim strTheText As String
   strTheText = "This is some text for a menu caption"
   GetTextDimensions strTheText, TWidth, THeight, FontSize:=20
   Dim EWidth As Long
   Dim EHeight As Long
   GetTextDimensions "=", EWidth, EHeight, FontSize:=20
   Picture1.Print strTheText
   Picture1.Print String(TWidth / EWidth, "=")
   MsgBox TWidth & vbLf & EWidth & vbLf & TWidth / EWidth
End Sub

Private Sub GetTextDimensions(ByVal TextString As String, ByRef TextWidth As Long, ByRef TextHeight As Long, Optional ByVal FontName As String = "Times New Roman", Optional ByVal FontSize As String = 12)
   Dim lngReturn As Long
   Dim lngDC As Long
   Dim DevM As DEVMODE
   Dim lfMyFont As LOGFONT
   Dim lngFont As Long
   Dim TextSize As POINTAPI
   Dim aryFontName() As Byte
   lngDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
   With lfMyFont
       SetFontFace lfMyFont, FontName
       .lfHeight = -MulDiv((FontSize), (GetDeviceCaps(lngDC, LOGPIXELSY)), 72)
   End With
   lngFont = CreateFontIndirect(lfMyFont)
   lngReturn = SelectObject(lngDC, lngFont)
   GetTextExtentPoint32 lngDC, TextString, Len(TextString), TextSize
   lngReturn = DeleteObject(lngFont)
   lngReturn = DeleteDC(lngDC)
   TextWidth = TextSize.X
   TextHeight = TextSize.Y
End Sub

Private Sub SetFontFace(ByRef MyFont As LOGFONT, ByVal DesiredName As String)
    Dim intElement As Integer
    For intElement = 0 To Len(DesiredName) - 1
        MyFont.lfFaceName(intElement) = Asc(Mid(DesiredName, intElement + 1, 1))
    MyFont.lfFaceName(Len(DesiredName)) = 0
End Sub

Tim Cottee


Top Expert 2006

Something like this might be on the track you're looking for.  It's definitely not the most efficient way of doing it though.

Public Function UnderlineMyText(ByVal FontName As String, ByVal FontSize As Double, ByVal TextString As String, ByVal UnderlineChar As String)
        Dim G As Graphics = Me.CreateGraphics   'Graphic objects
        Dim F As Font = New Font(FontName, FontSize)  'Font object
        Dim WidthOfText As Double = 0  'Width of the longest string (in twips)
        Dim WidthOfUnderline As Double = 0 'Width of the Underline (in twips)
        Dim strUnderline as String = Nothing

        'Get the twips width of the longest string
        WidthOfText = G.MeasureString(TextString, F).Width

        While WidthOfUnderline < WidthOfText
            strUnderline &= UnderlineChar
            WidthOfUnderline = G.MeasureString(strUnderline, F).Width
        End While
End Function
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.


Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.