PBWin Select Font Size to Fit Text to Area

[Gary Beene]

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:

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.

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.

'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