Function for calculating variable width font

Posted on 2006-03-20
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
    Hi william007,
    You can use TextWidth function. It is member function of form and it uses font of form as default font.


    Assisted Solution

    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();

    LVL 6

    Assisted Solution

    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)

    LVL 44

    Accepted Solution

    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
    LVL 9

    Author Comment

    LVL 17

    Expert Comment

    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

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How your wiki can always stay up-to-date

    Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
    - Increase transparency
    - Onboard new hires faster
    - Access from mobile/offline

    The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
    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.
    Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
    This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

    779 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

    Need Help in Real-Time?

    Connect with top rated Experts

    18 Experts available now in Live!

    Get 1:1 Help Now