Max font size printing to any screen size.

Code: (Select All)
'handle& = _NEWIMAGE(800, 600, 256)

'SCREEN handle&



handle& = _NEWIMAGE(_DESKTOPWIDTH, _DESKTOPHEIGHT, 256)

SCREEN handle&

_SCREENMOVE 0, 0

_DELAY .1

sw = _WIDTH

sh = _HEIGHT



x$ = "Fourscore and seven years ago our fathers brought forth, on this continent, a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal. Now we are engaged in a great civil war, testing whether that nation, or any nation so conceived, and so dedicated, can long endure. We are met on a great battle-field of that war. We have come to dedicate a portion of that field, as a final resting-place for those who here gave their lives, that that nation might live."

fs = 16



GOSUB getfonts



GOSUB getmaxchrs



seed = 1

DO

    x1$ = MID$(x$, seed, noc)

    chop = INSTR(MID$(x$ + " ", seed, noc), " ")

    IF MID$(x$ + " ", seed + noc, 1) = " " OR chop = 0 THEN

        PRINT MID$(x$, seed, noc);

        IF chop = 0 THEN seed = seed + noc ELSE seed = seed + noc + 1

    ELSE

        wrap = _INSTRREV(MID$(x$ + " ", seed, noc), " ")

        PRINT MID$(x$, seed, wrap - 1);

        seed = seed + wrap

    END IF

    IF seed >= LEN(x$) THEN EXIT DO ELSE yy = yy + 1: LOCATE yy + 1, 1

LOOP

b$ = INKEY$: SLEEP

SYSTEM



getfonts:

DO

    fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.

    font& = _LOADFONT(fontpath$, fs, "monospace")

    _FONT font&

    w1 = _FONTWIDTH

    h1 = _FONTHEIGHT

    nor = sh \ h1

    noc = sw \ w1

    maxchr = nor * noc

    IF flag THEN EXIT DO

    IF LEN(x$) >= maxchr - noc THEN fs = fs - 1: EXIT DO

    fs = fs + 1

LOOP

fontpath$ = ENVIRON$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.

font& = _LOADFONT(fontpath$, fs, "monospace")

_FONT font&

RETURN



getmaxchrs:

DO

    seed = 1: prow = 0

    DO

        x1$ = MID$(x$, seed, noc)

        chop = INSTR(MID$(x$ + " ", seed, noc), " ")

        IF MID$(x$ + " ", seed + noc, 1) = " " OR chop = 0 THEN

            prow = prow + 1

            IF chop = 0 THEN seed = seed + noc ELSE seed = seed + noc + 1

        ELSE

            wrap = _INSTRREV(MID$(x$ + " ", seed, noc), " ")

            seed = seed + wrap

            prow = prow + 1

        END IF

    LOOP UNTIL seed >= LEN(x$)



    IF prow <= nor THEN EXIT DO

    prow = 0

    fs = fs - 1

    IF fs = 0 THEN BEEP: END ' ERROR.

    flag = 1: GOSUB getfonts: flag = 0

LOOP

RETURN