Fancy font names

[mnrvovrfc]

This is a program that interacts with the user, asking him/her what is the "fancy" font name, and then it shows a dialog indicating what is the QB64 code line to use to load that font. The QB64 code line is copied to the clipboard so it could be pasted right away into the QB64 IDE.

It requires a text file called "fancy-font-names.txt" in the same directory as the executable.

This program was tested on Linux (Manjaro MATE) but with the provided text file it should work on Windows. I have listed only the fonts actually installed by "winetricks corefonts" by Debian v11 "Bullseye". I added one more, for Lucida Console which is not installed for Wine.

It's easy to add more fonts to the text file. Each line should have two fields separated by semicolon. In the first field enter the font name you wish to use. The second field is the full path of the filename of the font. Note that Bold, Italic, Semicondensed etc. are on separate TTF files than the "Regular" version and will be called differently.

It should be easier than ever to pull a text-file directory listing on Windows. Use

Code: (Select All)

dir /b/s C:\Windows\Fonts

the last time I checked. It has to be redirected to a text file, to then add the fancy names ending with semicolon at the front of each line. Tedious task, I know, but I did most of the work for you for the most common fonts.

The code is being shown here, but please download the ZIP attachment with this post.

Code: (Select All)

'by mnrvovrfc 27-May-2023
OPTION _EXPLICIT
$SCREENHIDE

TYPE twostring
    fancy AS STRING * 64
    apath AS STRING * 192
END TYPE

DIM infile$, oneline$, entry$, oldentry$
DIM AS LONG ff, sfl, i, u, lentry, choice

REDIM sf(1 TO 1) AS twostring

infile$ = "fancy-font-names.txt"
IF NOT _FILEEXISTS(infile$) THEN
    _MESSAGEBOX "File not found", "I'm sorry, but the required file wasn't found." + CHR$(13) + infile$, "info"
    SYSTEM
END IF
ff = FREEFILE
OPEN infile$ FOR INPUT AS ff
DO UNTIL EOF(ff)
    LINE INPUT #ff, oneline$
    u = INSTR(oneline$, ";")
    IF u > 0 THEN
        sfl = sfl + 1
        REDIM _PRESERVE sf(1 TO sfl) AS twostring
        sf(sfl).fancy = LEFT$(oneline$, u - 1)
        sf(sfl).apath = MID$(oneline$, u + 1)
    END IF
LOOP
CLOSE ff

entry$ = _INPUTBOX$("Fancy Font Names", "What is the fancy name of the font you'd like?", " ")
IF entry$ = "" THEN SYSTEM
oldentry$ = entry$
entry$ = LCASE$(entry$)
lentry = LEN(entry$)

choice = 0
oneline$ = ""
FOR i = 1 TO sfl
    oneline$ = LEFT$(LCASE$(RTRIM$(sf(i).fancy)), lentry)
    IF oneline$ = entry$ THEN choice = i: EXIT FOR
NEXT

IF choice THEN
    _MESSAGEBOX "Fancy Font Names", "The QB64 statement to load" + CHR$(13) + oldentry$ + " is " + chr$(34) +_
     "fonthandle = _LOADFONT(" + chr$(34) +rtrim$(sf(choice).apath) + chr$(34) + ", pointsize)" + chr$(13) +_
      "Be sure to set the " + chr$(34) + "pointsize" + chr$(34) +"as an integer from 8 to 128." + chr$(13) +_
       "The QB64 code line was copied to the clipboard.", "info"
    _CLIPBOARD$ = "fonthandle = _LOADFONT(" + CHR$(34) + RTRIM$(sf(choice).apath) + CHR$(34) + ", pointsize)"
ELSE
    _MESSAGEBOX "Font name not found", "I'm sorry, I was unable to find the filename for the fancy font you entered:" +_
     CHR$(13) + oldentry$, "info"
END IF
SYSTEM

Note: I have discovered two misbehaviors that can't be termed bugs. The _INPUTBOX$ produces "password mode" whether or not the third parameter is included as the empty string. That's why in this code it's actually a space which could be annoying to some people. The second thing is that on Linux on my side, the result of _CLIPBOARD$ puts double-quotation marks around the entire string that is stored. This is OK for pasting to RHS of a string assignment in this programming language; otherwise it wasn't expected.

  fancy-font-names.zip (Size: 1.48 KB / Downloads: 61)