Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Select Font Size to Fit Text to Area

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Select Font Size to Fit Text to Area

    Often a programmer needs to size text (change the font) so that it fills
    an area as much as possible. Since there is no Windows API to return a
    font given an area to fill, programmers have to provide their own code.

    Two approaches are given here - a single line equation and a Do Loop that
    iterates the font size until the text fits within the area. In the first approach,
    Paul Dixon gets credit for modifying an equation I posted. His gives much better
    results. Chris Boss gets credit for reminding me that a binary search approach
    would be faster than the simple Do Loop I posted (the binary search approach
    is given below).

    Both solutions provided here assume the text is to be printed in a graphic control.

    Here's the single equation solution:

    Code:
    Function GetFontSize_Graphic2(w As Long, h As Long, txt$, scalefactor As Single, fontName$) AS LONG
        Local x As Long, y As Long
        Graphic Font fontName$, 1000, 1
        Graphic Text Size txt$ To x,y
        Function=  1000/IIF( x/w > y/h , x/(w*scalefactor) , y/(h*scalefactor) )   
    End Function
    'And here's the binary search style Do Loop solution. It's up to 10x faster than a linear search loop.

    Code:
    Function GetFontSize_Graphic4(w As Long, h As Long, txt$, factor As Single, fName$) As Long
        Local x As Long, y As Long, fSize As Long, Upper As Long, Lower As Long
        Lower = 1 : Upper = 1000
        Do Until (Upper <= (Lower + 1))
            fSize = (Lower + Upper) / 2
            Graphic Font fName$, fSize, 1
            Graphic Text Size txt$ To x,y
            If (x < factor*w) AND (y < factor*h) Then
               Lower = fSize       'fits inside
            Else
               Upper = fSize      'goes outside
            End If
        Loop
        Function = Lower
    End Function
    A compilable example using both of these solutions is provided below,
    and is also available in the gbSnippets PowerBASIC source code library
    (snippet# gbs_00360). You can get the entire library by downloading
    gbSnippets or you can view individual snippets online.

    gbSnippets home page: http://www.garybeene.com/sw/gbsnippets.htm
    Online source code listings: http://www.garybeene.com/power/code/

    If you've already installed gbSnippets, you can ensure that your local
    library is synchronized with the latest snippets on the gbSnippets server
    by using the "Actions/Synchronize with gbSnippets Server" menu.


    Code:
    'Compilable Example:
    #Compile Exe
    #Dim All
    #Include "win32api.inc"
    Global hDlg As Dword
    Function PBMain () As Long
       Local w As Long, h As Long
       Desktop Get Client To w, h
       Dialog New Pixels, 0, "Control Resize",100,100,200,200, %WS_OverlappedWindow To hDlg
       Control Add Graphic, hDlg, 300,"", 0,0,w,h, %WS_Visible Or %SS_Sunken
       Graphic Attach hDlg, 300, Redraw
       Dialog Show Modal hDlg Call DlgProc
    End Function
    
    CallBack Function DlgProc() As Long
       Select Case CB.Msg
          Case %WM_Size
             Dim w As Long, h As Long, x As Long, y As Long, txt$, fSize&, fName$
             Dialog Get Client CB.Hndl To w,h
             Control Set Size CB.Hndl, 300, w-20, h-20
             txt$ = "Sample Text"
             fName$ = "Comic MS Sans"
             'get fontsize
             fSize& = GetFontSize_Graphic4(w, h, txt$, 0.9, fName$)
             'center and print
             Graphic Clear
             Graphic Font fName$, fSize&, 1
             Graphic Text Size txt$ To x,y
             Graphic Set Pos ((w-x)/2,(h-y)/2)
             Graphic Print txt$
             Graphic Redraw
       End Select
    End Function
    
    Function GetFontSize_Graphic2(w As Long, h As Long, txt$, factor As Single, fontName$) AS LONG
        Local x As Long, y As Long
        Graphic Font fontName$, 1000, 1
        Graphic Text Size txt$ To x,y
        Function=  1000/IIF( x/w > y/h , x/(w*factor) , y/(h*factor) )   
    End Function
    
    Function GetFontSize_Graphic3(w As Long, h As Long, txt$, factor As Single, fName$) As Long
        Local x As Long, y As Long, fS&
        Do Until x > factor * w Or y > factor * h
            Incr fS&
            Graphic Font fName$, fS&, 1
            Graphic Text Size txt$ To x,y
        Loop
        Dialog Set Text hDlg, Str$(fS&)
        Function = fS&
    End Function
    
    Function GetFontSize_Graphic4(w As Long, h As Long, txt$, factor As Single, fName$) As Long
        Local x As Long, y As Long, fSize As Long, Upper As Long, Lower As Long
        Lower = 1 : Upper = 1000
        Do Until (Upper <= (Lower + 1))
            fSize = (Lower + Upper) / 2
            Graphic Font fName$, fSize, 1
            Graphic Text Size txt$ To x,y
            If (x < factor*w) AND (y < factor*h) Then
               Lower = fSize       'fits inside
            Else
               Upper = fSize      'goes outside
            End If
        Loop
        Function = Lower
    End Function
    
    'gbs_00360
    Last edited by Gary Beene; 9 Oct 2009, 10:41 AM.
Working...
X