How to recover the FB font applied to an unknown graphics screen

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

How to recover the FB font applied to an unknown graphics screen

Post by fxm »

The procedure below has no a priori on the graphic screen applied and allows to recover the FB font height applied among 8, 14 or 16 pixels (font width = 8 pixels always):

Code: Select all

Function fontHeight() As Ulong
    Dim As Ulong h, r, f = 8
    Screeninfo( , h)
    r = Hiword(Width)
    If h \ 14 = r Then f = 14
    If h \ 16 = r Then f = 16
    Return f
End Function

Example with a random font height change among the 3 FB available (escape to exit, any other key to continue):

Code: Select all

Function fontHeight() As Ulong
    Dim As Ulong h, r, f = 8
    Screeninfo( , h)
    r = Hiword(Width)
    If h \ 14 = r Then f = 14
    If h \ 16 = r Then f = 16
    Return f
End Function

Const w = 320, h = 200
ScreenRes w, h

Dim As Ulong font(0 To 2) = {8, 14, 16}
Dim As Long p0 = 0

Do
    Dim As Long p
    Do
        p = Int(Rnd * 3)
    Loop While p = p0
    p0 = p
    Dim As Ulong n = h \ font(p)
    Width , n
    Cls
    Print , "Wished", "Obtained"
    Print "pages : ", n, Hiword(Width)
    Print "font  : ", "8*" & font(p), "8*" & fontHeight();
    Sleep
Loop Until Inkey = Chr(27)
Last edited by fxm on May 12, 2024 19:40, edited 8 times in total.
Reason: Code updated.
dafhi
Posts: 1673
Joined: Jun 04, 2005 9:51

Re: How to recover the FB font applied to an unknown graphics screen

Post by dafhi »

uint needs to be long or ulong
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How to recover the FB font applied to an unknown graphics screen

Post by fxm »

Yes thanks.
fxm
Moderator
Posts: 12181
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: How to recover the FB font applied to an unknown graphics screen

Post by fxm »

WARNING:
  • Depending on the height size of a graphics screen, the command ('WIDTH , screenHeightSize \ fontHeightSize') to choose a number of whole lines ('screenHeightSize \ fontHeightSize') associated with a given font height size ('fontHeightSize') fails sometimes, because not all possible combinations are supported by the system, and that 'screenHeightSize \ fontHeightSize' may provide the same value for different fonts (for small height sizes of screen):
    • or the obtained font height size is not the expected one (usually smaller),
    • or the obtained number of whole lines is not the expected one (usually higher),
    • or both together.
    • The bad configuration obtained may even depend on which one comes from, when 'WIDTH' commands are chained for the same graphics screen. One can thus obtain at worst a number of whole lines applied lower than that requested ('screenHeightSize \ fontHeightSize'), with a font applied larger than that wished ('fontHeightSize').
  • Likewise, the above 'fontHeight()' procedure for determining the size of the applied font height could also fail sometimes. But on the other hand, the number of errors seems to be null (I thought I saw an error that I can not find again), because the procedure takes into account the number of whole lines actually applied.
  • Example of 'WIDTH' command failing (random font height changing : escape to exit, any other key to continue).
    Under Windows 10, requested : 4 pages with 8*16 font, obtained : 5 pages with 8*14 font or 8 pages with 8*8 font, depending on the previous command:

    Code: Select all

    Function fontHeight() As Ulong
        Dim As Ulong h, r, f = 8
        Screeninfo( , h)
        r = Hiword(Width)
        If h \ 14 = r Then f = 14
        If h \ 16 = r Then f = 16
        Return f
    End Function
    
    Const w = 320, h = 70
    ScreenRes w, h
    
    Dim As Ulong font(0 To 2) = {8, 14, 16}
    Dim As Long p0 = 0
    
    Do
        Dim As Long p
        Do
            p = Int(Rnd * 3)
        Loop While p = p0
        p0 = p
        Dim As Ulong n = h \ font(p)
        Width , n
        Cls
        Print , "Wished", "Obtained"
        Print "pages : ", n, Hiword(Width)
        Print "font  : ", "8*" & font(p), "8*" & fontHeight();
        Sleep
    Loop Until Inkey = Chr(27)
    
Last edited by fxm on May 12, 2024 19:41, edited 8 times in total.
Reason: Added example.
Post Reply