Function for calculating variable width font

Posted on 2006-03-20
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)

Question by:william007
LVL 14

Assisted Solution

by:Farzad Akbarnejad
Farzad Akbarnejad earned 400 total points
ID: 16244469
Hi william007,
You can use TextWidth function. It is member function of form and it uses font of form as default font.


Assisted Solution

AmirSch earned 400 total points
ID: 16245202
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();


Assisted Solution

cubixSoftware earned 200 total points
ID: 16245310
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)


Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

LVL 43

Accepted Solution

TimCottee earned 1000 total points
ID: 16245863
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

Author Comment

ID: 16246394
LVL 17

Expert Comment

ID: 16246418
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

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question