Select Font Size to Fill Area

[Gary Beene Member Find all posts View Profile Close Gary Beene]

I have code that uses a loop to get the font size of a text string that would fill an area (example shown at the bottom of this post, for a graphic control).

But what I'd like to do is come up with an approximate equation (exact would be ok too) and avoid the loop.

For example, this single line of code will generate a font size that is bounded by an area of WxH. Yes, it does a really poor job, but it demonstrates what I'd like to come up with.

fSize& = IIF( w<h, 0.1*w, 0.1*h)

The forum posts I've found mostly talk about looping solutions, mostly using GetTextExtent32. I didn't seen anything here, or on the web in general, that discusses a single equation-based font size calculation. An approximate answer would be fine - although not as approximate as the simple line of code I give above.

I'm experimenting with some code that's similar to creating gradient colors on a screen, but haven't come up with anything exciting so far.

Anyone seen anything along those lines?

Here's the looping code that gives an accurate answer (for a graphic control area in this case).

'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&
         Dialog Get Client Cb.Hndl To w,h
         Control Set Size Cb.Hndl, 300, w-20, h-20
         txt$ = "Sample Text"

         'center and print
         fSize& = GetFontSize_Graphic(w, h, txt$, 0.9)
         Graphic Clear
         Graphic Font "Comic MS Sans", 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_Graphic(w As Long, h As Long, txt$, factor As Single) As Long
    Local x As Long, y As Long, fS&
    Do Until x > factor * w Or y > factor * h
        Incr fS&
        Graphic Font "Comic MS Sans", fS&, 1
        Graphic Text Size txt$ To x,y
    Loop
    Function = fS&
End Function

'gbs_00360

[Michael Mattias Member Find all posts View Profile Close Michael Mattias]

There really is no way - at least when using a proportional font - because what will fit depends on the specific text... IF the width is your limiting factor.

I would think height could also be a limiting factor if your text does/does not contain any caps, or any letters with descenders.

Perhaps using a monospaced font there's a way?

But do you really want to change the font size based on content? As a user I would find it distracting as hell to see different font sizes for the same information.

[Gary Beene Member Find all posts View Profile Close Gary Beene]

Yep, I really want to. And the need is to take height and width of the actual text into account - not just width.

I could give the user a fixed number of screen sizes. That would let me pre-select the font size to give a better visual look. But I've already made it resizable and the user likes it (even with the bad resizing code). But I felt badly about it anyway and am looking for a better algorithm to resize the font.

Push comes to shove, I'll use the loop example I gave. Any flickering on resize probably won't be an issue for him, but I'll know it's there.

Like my **** unpopular equation for dates in an earlier post, I was hoping to end up with an equation-based solution to font-fit-sizing.

... and of course I let the user pick a font already, so fixed width font is out. I like add-to solutions, not take-away ones.

[Chris Boss Member Find all posts View Profile Close Chris Boss]

Yes, there is a faster way.

The technique goes like this:

Define a minimum and maximum font point size (a range).

ie.

Min=1
Max=72

Then start in the middle of the range.

ie.

testsize=36

See if the font created is smaller or larger than the define area.

If smaller, then your new range is:

Min=1
Max=35

If larger, then your new range is:

Min=37
Max=72

Now test the middle of the new range and see if that font size is smaller than the defined area.

Keep doing this, by splitting the range in half, again and again until you find the best match.

Every time you split the range in half, you have eliminated half of the possible font sizes to test. This decreases the number of font sizes to actually test and your code will execute much, much faster.

[Gary Beene Member Find all posts View Profile Close Gary Beene]

Hi Chris,

And thanks - I had thought about that already, but was mind-locked on a one-liner solution.

In the mean time, I"ll follow your suggestion and code up the alternative to see how it works!

Gary

[Paul Dixon Member Find all posts View Profile Close Paul Dixon]

Gary,
is this what you need?

FUNCTION GetFontSize_Graphic2(w AS LONG, h AS LONG, txt$, factor AS SINGLE) AS LONG
LOCAL x AS LONG, y AS LONG , SCALE AS SINGLE
    GRAPHIC FONT "Comic MS Sans", 1000, 1
    GRAPHIC TEXT SIZE txt$ TO x,y
    IF x/w > y/h THEN
        scale!=x/(w  *factor)
    ELSE
        scale!=y/(h  *factor)
    END IF

    FUNCTION = 1000/scale!
  
END FUNCTION

Paul.

[Paul Dixon Member Find all posts View Profile Close Paul Dixon]

but was mind-locked on a one-liner solution

FUNCTION GetFontSize_Graphic2(w AS LONG, h AS LONG, txt$, factor AS SINGLE) AS LONG
LOCAL x AS LONG, y AS LONG , SCALE AS SINGLE
    GRAPHIC FONT "Comic MS Sans", 1000, 1
    GRAPHIC TEXT SIZE txt$ TO x,y
    
    FUNCTION=  1000/IIF( x/w > y/h , x/(w*factor) , y/(h*factor) )   
  
END FUNCTION

[Gary Beene Member Find all posts View Profile Close Gary Beene]

Sorry Paul, I have to leave for a tennis match. I'll look at your code when I get back - thanks!

Gary

[Gary Beene Member Find all posts View Profile Close Gary Beene]

Well, that was a really long tennis match!

Chris/Paul, thanks for the suggestions. My final code is given below. Paul, I modified your only very slightly. Chris, the binary search I coded seems to work fine. Feel free to comment on it if you see something amiss.

From just looking at the two solutions, the answers seem to be visually identical. I ran a brief comparison test to see what answer each gives ... here's the results. It seems close enough that a person would pick the single equation answer over the loop.

Size         #2    #4
200 x 200    23   22
200 x 400    23   22
400 x 200    46   46
400 x 400    46   46
400 x 800    46   46
800 x 400    92   91
800 x 800    92   91
800 x 1200   92   91
1200 x 800  138  136

I've added both approaches to my gbSnippets PowerBASIC source code library and will post the code in the source forum next week.

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

Chris, here's what I did using the binary search concept we talked about. It seems to work great and can be as much as 10X faster than using the simple Do Loop I posted earlier. In this version, I limited the possible font values to whole numbers, but I would think it will work on non-integer font sizes as well. The (Lower+1) would have to change to match the precision of an acceptable answer.

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