wanted: program to process Windows Font files

Code: (Select All)
$VersionInfo:Comments=Testing Font Dialogs

$If FONTDBI = UNDEFINED Then

    $Let FONTDBI = TRUE

    Const HKEY_CLASSES_ROOT = &H80000000~&

    Const HKEY_CURRENT_USER = &H80000001~&

    Const HKEY_LOCAL_MACHINE = &H80000002~&

    Const HKEY_USERS = &H80000003~&

    Const HKEY_PERFORMANCE_DATA = &H80000004~&

    Const HKEY_CURRENT_CONFIG = &H80000005~&

    Const HKEY_DYN_DATA = &H80000006~&

    Const REG_OPTION_VOLATILE = 1

    Const REG_OPTION_NON_VOLATILE = 0

    Const REG_CREATED_NEW_KEY = 1

    Const REG_OPENED_EXISTING_KEY = 2

    Const REG_NONE = 0

    Const REG_SZ = 1

    Const REG_EXPAND_SZ = 2

    Const REG_BINARY = 3

    Const REG_DWORD_LITTLE_ENDIAN = 4 '   value is defined REG_DWORD in Windows header files

    Const REG_DWORD = 4 '                  32-bit number

    Const REG_DWORD_BIG_ENDIAN = 5 '       some UNIX systems support big-endian architectures

    Const REG_LINK = 6

    Const REG_MULTI_SZ = 7

    Const REG_RESOURCE_LIST = 8

    Const REG_FULL_RESOURCE_DESCRIPTOR = 9

    Const REG_RESOURCE_REQUIREMENTS_LIST = 10

    Const REG_QWORD_LITTLE_ENDIAN = 11 '  64-bit number in little-endian format

    Const REG_QWORD = 11 '                 64-bit number

    Const REG_NOTIFY_CHANGE_NAME = 1

    Const REG_NOTIFY_CHANGE_ATTRIBUTES = 2

    Const REG_NOTIFY_CHANGE_LAST_SET = 4

    Const REG_NOTIFY_CHANGE_SECURITY = 8

    Const KEY_ALL_ACCESS = &HF003F&

    Const KEY_CREATE_LINK = &H0020&

    Const KEY_CREATE_SUB_KEY = &H0004&

    Const KEY_ENUMERATE_SUB_KEYS = &H0008&

    Const KEY_EXECUTE = &H20019&

    Const KEY_NOTIFY = &H0010&

    Const KEY_QUERY_VALUE = &H0001&

    Const KEY_READ = &H20019&

    Const KEY_SET_VALUE = &H0002&

    Const KEY_WOW64_32KEY = &H0200&

    Const KEY_WOW64_64KEY = &H0100&

    Const KEY_WRITE = &H20006&

    Const ERROR_SUCCESS = 0

    Const ERROR_FILE_NOT_FOUND = &H2&

    Const ERROR_INVALID_HANDLE = &H6&

    Const ERROR_MORE_DATA = &HEA&

    Const ERROR_NO_MORE_ITEMS = &H103&

    Declare Dynamic Library "advapi32"

        Function RegOpenKeyExA& (ByVal hKey As _Offset, Byval lpSubKey As _Offset, Byval ulOptions As _Unsigned Long, Byval samDesired As _Unsigned Long, Byval phkResult As _Offset)

        Function RegCloseKey& (ByVal hKey As _Offset)

        Function RegEnumValueA& (ByVal hKey As _Offset, Byval dwIndex As _Unsigned Long, Byval lpValueName As _Offset, Byval lpcchValueName As _Offset, Byval lpReserved As _Offset, Byval lpType As _Offset, Byval lpData As _Offset, Byval lpcbData As _Offset)

    End Declare

    Const CF_APPLY = &H200& '             Displays Apply button

    Const CF_ANSIONLY = &H400& '          list ANSI fonts only

    Const CF_BOTH = &H3& '                list both Screen and Printer fonts

    Const CF_EFFECTS = &H100& '          Display Underline and Strike Through boxes

    Const CF_ENABLEHOOK = &H8& '          set hook to custom template

    Const CF_ENABLETEMPLATE = &H10& '     enable custom template

    Const CF_ENABLETEMPLATEHANDLE = &H20&

    Const CF_FIXEDPITCHONLY = &H4000& '  list only fixed-pitch fonts

    Const CF_FORCEFONTEXIST = &H10000& '  indicate error when font not listed is chosen

    Const CF_INACTIVEFONTS = &H2000000& ' display hidden fonts in Win 7 only

    Const CF_INITTOLOGFONTSTRUCT = &H40& 'use the structure pointed to by the lpLogFont member

    Const CF_LIMITSIZE = &H2000& '        select font sizes only within nSizeMin and nSizeMax members

    Const CF_NOOEMFONTS = &H800& '        should not allow vector font selections

    Const CF_NOFACESEL = &H80000& '       prevent displaying initial selection in font name combo box.

    Const CF_NOSCRIPTSEL = &H800000& '    Disables the Script combo box

    Const CF_NOSIMULATIONS = &H1000& '    Disables selection of font simulations

    Const CF_NOSIZESEL = &H200000& '     Disables Point Size selection

    Const CF_NOSTYLESEL = &H100000& '     Disables Style selection

    Const CF_NOVECTORFONTS = &H800&

    Const CF_NOVERTFONTS = &H1000000&

    Const CF_OEMTEXT = &H7&

    Const CF_PRINTERFONTS = &H2& '        list fonts only supported by printer associated with the device

    Const CF_SCALABLEONLY = &H20000& '    select only vector fonts, scalable printer fonts, and TrueType fonts

    Const CF_SCREENFONTS = &H1& '        lists only the screen fonts supported by system

    Const CF_SCRIPTSONLY = &H400& '       lists all non-OEM, Symbol and ANSI sets only

    Const CF_SELECTSCRIPT = &H400000& '  can only use set specified in the Scripts combo box

    Const CF_SHOWHELP = &H4& '           displays Help button reference

    Const CF_TTONLY = &H40000& '         True Type only

    Const CF_USESTYLE = &H80& '           copies style data for the user's selection to lpszStyle buffer

    Const CF_WYSIWYG = &H8000& '          only list fonts available on both the printer and display

    Const BOLD_FONTTYPE = &H100&

    Const ITALIC_FONTTYPE = &H200&

    Const PRINTER_FONTTYPE = &H4000&

    Const REGULAR_FONTTYPE = &H400&

    Const SCREEN_FONTTYPE = &H2000&

    Const SIMULATED_FONTTYPE = &H8000&

    Const FW_DONTCARE = 0

    Const FW_THIN = 100

    Const FW_ULTRALIGHT = 200

    Const FW_LIGHT = 300

    Const FW_REGULAR = 400

    Const FW_MEDIUM = 500

    Const FW_SEMIBOLD = 600

    Const FW_BOLD = 700

    Const FW_ULTRABOLD = 800

    Const FW_HEAVY = 900

    Const DEFAULT_CHARSET = 1

    Const LF_DEFAULT = 0

    Const FF_ROMAN = 16

    Const LF_FACESIZE = 32

    Const GMEM_MOVEABLE = &H2

    Const GMEM_ZEROINIT = &H40

    Declare Dynamic Library "comdlg32"

        Function ChooseFont& Alias "ChooseFontA" (ByVal lpcf As _Offset)

        Function CommDlgExtendedError& () '                'dialog box error checking procedure

    End Declare

    Type CHOOSEFONT

        As _Unsigned Long lStructSize

        $If 64BIT Then

            As String * 4 alignment

        $End If

        As _Offset hwndOwner, hDC, lpLogFont

        As Long iPointSize

        As _Unsigned Long Flags, rgbColors

        $If 64BIT Then

            As String * 4 alignment2

        $End If

        As _Offset lCustData, lpfnHook, lpTemplateName, hInstance, lpszStyle

        As _Unsigned Integer nFontType

        As String * 2 alignment3

        As Long nSizeMin, nSizeMax

        $If 64BIT Then

            As String * 4 alignment4

        $End If

    End Type

    Type LOGFONT

        lfHeight As Long

        lfWidth As Long

        lfEscapement As Long

        lfOrientation As Long

        lfWeight As Long

        lfItalic As _Byte '    not 0 when user selected

        lfUnderline As _Byte ' not 0 when user selected

        lfStrikeOut As _Byte ' not 0 when user selected

        lfCharSet As _Byte

        lfOutPrecision As _Byte

        lfClipPrecision As _Byte

        lfQuality As _Byte

        lfPitchAndFamily As _Byte

        lfFaceName As String * 32 'contains name listed in dialog

    End Type

    Dim Shared FontType As String

    Dim Shared PointSize&

    Dim Shared FontColor&

    Dim Shared fontpath As String

    Dim Shared selectedfont As String

    Dim Shared FontName As String

    Dim Shared FontEff As String

$End If



'MAIN MODULE

_Title "LoadFont Test with Accurate Search"

Screen _NewImage(1280, 720, 32)

AGAIN:

Cls

_Font 16

y = CsrLin

x = Pos(0)

f& = LoadFont

If f& > 0 Then

    _Font f&

    Locate 20, x

    Print "This is "; FontName; ", loaded from "; selectedfont; " in"; PointSize&; "points"

    Print "Go again? (Y/N)"

Else

    System

End If

Do

    k$ = InKey$

    If UCase$(k$) = "Y" Then

        GoTo AGAIN

    ElseIf UCase$(k$) = "N" Then

        System

    End If

Loop Until UCase$(k$) = "Y" Or UCase$(k$) = "N"

'END MAIN MODULE



$If FONTDBM = UNDEFINED Then

    $Let FONTDBM = TRUE

    Sub GetFonts

        Dim hKey As _Offset

        Dim Ky As _Offset

        Dim SubKey As String

        Dim Value As String

        Dim bData As String

        Dim t As String

        Dim dwType As _Unsigned Long

        Dim numBytes As _Unsigned Long

        Dim numTchars As _Unsigned Long

        Dim l As Long

        Dim dwIndex As _Unsigned Long

        FONTFILE = FreeFile

        Open "F0NTList.INF" For Output As #FONTFILE 'create a new file for font data

        Ky = HKEY_LOCAL_MACHINE

        SubKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" + Chr$(0)

        Value = Space$(261) 'ANSI Value name limit 260 chars + 1 null

        bData = Space$(&H7FFF) 'arbitrary

        l = RegOpenKeyExA(Ky, _Offset(SubKey), 0, KEY_READ, _Offset(hKey))

        If l Then

        Else

            dwIndex = 0

            Do

                numBytes = Len(bData)

                numTchars = Len(Value)

                l = RegEnumValueA(hKey, dwIndex, _Offset(Value), _Offset(numTchars), 0, _Offset(dwType), _Offset(bData), _Offset(numBytes))

                If l Then

                    Exit Do

                Else

                    Print #FONTFILE, Left$(Value, numTchars) + "=" + formatData(dwType, numBytes, bData)

                End If

                dwIndex = dwIndex + 1

            Loop

            Close #FONTFILE

            l = RegCloseKey(hKey)

        End If

    End Sub

    Function whatType$ (dwType As _Unsigned Long)

        Select Case dwType

            Case REG_SZ: whatType = "REG_SZ"

            Case REG_EXPAND_SZ: whatType = "REG_EXPAND_SZ"

            Case REG_BINARY: whatType = "REG_BINARY"

            Case REG_DWORD: whatType = "REG_DWORD"

            Case REG_DWORD_BIG_ENDIAN: whatType = "REG_DWORD_BIG_ENDIAN"

            Case REG_LINK: whatType = "REG_LINK"

            Case REG_MULTI_SZ: whatType = "REG_MULTI_SZ"

            Case REG_RESOURCE_LIST: whatType = "REG_RESOURCE_LIST"

            Case REG_FULL_RESOURCE_DESCRIPTOR: whatType = "REG_FULL_RESOURCE_DESCRIPTOR"

            Case REG_RESOURCE_REQUIREMENTS_LIST: whatType = "REG_RESOURCE_REQUIREMENTS_LIST"

            Case REG_QWORD: whatType = "REG_QWORD"

            Case Else: whatType = "unknown"

        End Select

    End Function

    Function whatKey$ (hKey As _Offset)

        Select Case hKey

            Case HKEY_CLASSES_ROOT: whatKey = "HKEY_CLASSES_ROOT"

            Case HKEY_CURRENT_USER: whatKey = "HKEY_CURRENT_USER"

            Case HKEY_LOCAL_MACHINE: whatKey = "HKEY_LOCAL_MACHINE"

            Case HKEY_USERS: whatKey = "HKEY_USERS"

            Case HKEY_PERFORMANCE_DATA: whatKey = "HKEY_PERFORMANCE_DATA"

            Case HKEY_CURRENT_CONFIG: whatKey = "HKEY_CURRENT_CONFIG"

            Case HKEY_DYN_DATA: whatKey = "HKEY_DYN_DATA"

        End Select

    End Function

    Function formatData$ (dwType As _Unsigned Long, numBytes As _Unsigned Long, bData As String)

        Dim t As String

        Dim ul As _Unsigned Long

        Dim b As _Unsigned _Byte

        Select Case dwType

            Case REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ

                formatData = Left$(bData, numBytes - 1)

            Case REG_DWORD

                t = LCase$(Hex$(CVL(Left$(bData, 4))))

                formatData = "0x" + String$(8 - Len(t), &H30) + t

            Case Else

                If numBytes Then

                    b = Asc(Left$(bData, 1))

                    If b < &H10 Then

                        t = t + "0" + LCase$(Hex$(b))

                    Else

                        t = t + LCase$(Hex$(b))

                    End If

                End If

                For ul = 2 To numBytes

                    b = Asc(Mid$(bData, ul, 1))

                    If b < &H10 Then

                        t = t + " 0" + LCase$(Hex$(b))

                    Else

                        t = t + " " + LCase$(Hex$(b))

                    End If

                Next

                formatData = t

        End Select

    End Function

    Function ShowFont$ (hWnd As _Offset)

        Dim cf As CHOOSEFONT

        Dim lfont As LOGFONT

        Shared FontColor&, FontType$, FontEff$, PointSize As Long 'shared with main program

        lfont.lfHeight = LF_DEFAULT ' determine default height '       set dailog box defaults

        lfont.lfWidth = LF_DEFAULT ' determine default width

        lfont.lfEscapement = LF_DEFAULT ' angle between baseline and escapement vector

        lfont.lfOrientation = LF_DEFAULT ' angle between baseline and orientation vector

        lfont.lfWeight = FW_REGULAR ' normal weight i.e. not bold

        lfont.lfCharSet = DEFAULT_CHARSET ' use default character set

        lfont.lfOutPrecision = LF_DEFAULT ' default precision mapping

        lfont.lfClipPrecision = LF_DEFAULT ' default clipping precision

        lfont.lfQuality = LF_DEFAULT ' default quality setting

        lfont.lfPitchAndFamily = LF_DEFAULT Or FF_ROMAN ' default pitch, proportional with serifs

        lfont.lfFaceName = "Calibri" + Chr$(0) ' string must be null-terminated

        cf.lStructSize = Len(cf) ' size of structure

        cf.hwndOwner = hWnd ' window opening the dialog box

        cf.lpLogFont = _Offset(lfont)

        cf.iPointSize = 120 ' 12 point font (in units of 1/10 point)

        cf.Flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE

        cf.rgbColors = _RGB(238, 161, 50)

        cf.nFontType = REGULAR_FONTTYPE ' regular font type i.e. not bold or anything

        cf.nSizeMin = 10 ' minimum point size

        cf.nSizeMax = 72 ' maximum point size

        If ChooseFont&(_Offset(cf)) <> 0 Then '    'Initiate Dialog and Read user selections

            ShowFont = Left$(lfont.lfFaceName, InStr(lfont.lfFaceName, Chr$(0)) - 1)

            FontColor& = _RGB(_Blue32(cf.rgbColors), _Green32(cf.rgbColors), _Red32(cf.rgbColors))

            If cf.nFontType And BOLD_FONTTYPE Then FontType$ = "Bold"

            If cf.nFontType And ITALIC_FONTTYPE Then FontType$ = FontType$ + " Italic"

            If cf.nFontType And REGULAR_FONTTYPE Then FontType$ = "Regular"

            If lfont.lfUnderline Then FontEff$ = "Underline"

            If lfont.lfStrikeOut Then FontEff$ = FontEff$ + "Strikeout"

            PointSize = cf.iPointSize \ 10

        Else

            ShowFont = ""

        End If

    End Function

    Function LoadFont&

        Font$ = ShowFont(_WindowHandle) '           call Dialog Box and get the font selection

        If Font$ <> "" Then

            F = FreeFile

            Dim fontlist(n) As String

            Open "F0NTList.INF" For Binary As #F

            If LOF(F) = 0 Then GetFonts

            Do

                If Not EOF(F) Then

                    Line Input #F, regfont$

                    i = i + 1

                    ReDim _Preserve fontlist(i) As String

                    fontlist(i) = regfont$

                End If

            Loop Until EOF(F)

            Close #F

            ReDim Results(0) As Results

            FFont$ = Font$

            a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 1) 'test1

            Print "="; Font$; " "; FontType$

            If a > 1 Or a = 0 Then

                Print "Couldn't find it with first search, broadening"

                a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 0) 'test2

                Print "%"; Font$; " "; FontType$

                If a = 0 Then

                    Print "Couldn't find it with second search, broadening"

                    If Left$(Font$, InStr(Font$, " ")) = "" Then

                        a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 1) 'test3

                        Print "="; String.Trim(Font$ + " " + FontType$)

                    Else

                        a = Array_String.FindAny(fontlist(), Left$(Font$, InStr(Font$, " ")) + FontType$, Results(), 1) 'test3

                        Print "="; Left$(Font$, InStr(Font$, " ")) + FontType$

                    End If

                    If a = 0 Then

                        Print "Couldn't find it with third search, broadening"

                        If Left$(Font$, InStr(Font$, " ")) = "" Then

                            a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 0) 'test4

                            Print "%"; String.Trim(Font$ + " " + FontType$)

                        Else

                            a = Array_String.FindAny(fontlist(), Left$(Font$, InStr(Font$, " ")) + FontType$, Results(), 0) 'test4

                            Print "%"; Left$(Font$, InStr(Font$, " ")) + FontType$

                        End If

                        If a = 0 Then

                            Print "Couldn't find it with fourth search, broadening"

                            a = Array_String.FindAny(fontlist(), Font$, Results(), 1) 'test5

                            Print "="; Font$

                            If a = 0 Then

                                Print "Couldn't find it with fifth search, broadening"

                                a = Array_String.FindAny(fontlist(), Font$, Results(), 0) 'test6

                                Print "%"; Font$

                                If a = 0 Then

                                    Print "Couldn't find it with sixth search, broadening"

                                    If Left$(Font$, InStr(Font$, " ")) = "" Then

                                        a = Array_String.FindAny(fontlist(), String.Trim(Font$), Results(), 1) 'test7

                                        Print "="; String.Trim(Font$)

                                    Else

                                        a = Array_String.FindAny(fontlist(), Left$(Font$, InStr(Font$, " ")), Results(), 1) 'test7

                                        Print "="; Left$(Font$, InStr(Font$, " "))

                                    End If

                                    If a = 0 Then

                                        Print "Couldn't find it with seventh search, broadening"

                                        If Left$(Font$, InStr(Font$, " ")) = "" Then

                                            a = Array_String.FindAny(fontlist(), String.Trim(Font$), Results(), 0) 'test8

                                            Print "%"; String.Trim(Font$)

                                        Else

                                            a = Array_String.FindAny(fontlist(), Left$(Font$, InStr(Font$, " ")), Results(), 0) 'test8

                                            Print "%"; Left$(Font$, InStr(Font$, " "))

                                        End If

                                        If a = 0 Then

                                            Print "Couldn't find a suitable font matching that search term in all 8 searches"

                                            Print "Last ditch effort to find font"

                                            If Left$(Font$, InStr(Font$, " ")) = "" Then

                                                LastDitchEffort$ = LastDitch(fontlist(), String.Trim(Font$)) 'test9

                                            Else

                                                LastDitchEffort$ = LastDitch(fontlist(), Left$(Font$, InStr(Font$, " "))) 'test9

                                            End If

                                            If LastDitchEffort$ = "" Then

                                                Print "Cannot find the font."

                                                Print "Ending"

                                                End

                                            Else

                                                Print LastDitchEffort$

                                            End If

                                        End If

                                    End If

                                End If

                            End If

                        End If

                    End If

                End If

            End If

            If LastDitchEffort$ = "" Then

                For y = LBound(Results) To UBound(Results)

                    If InStr(Results(y).Result, Left$(Font$, _InStrRev(Font$, " "))) And InStr(UCase$(FontType$), "ITALIC") = 0 And InStr(UCase$(FontType$), "BOLD") = 0 Then

                        Print Results(y).Result

                        'PRINT "TRUE1"

                        Exit For

                    ElseIf InStr(Results(y).Result, Font$ + " " + FontType$) Then

                        Print Results(y).Result

                        'PRINT "TRUE2"

                        Exit For

                    ElseIf InStr(UCase$(FontType$), "ITALIC") And InStr(UCase$(FontType$), "BOLD") = 0 And InStr(UCase$(Results(y).Result), "ITALIC") And InStr(UCase$(Results(y).Result), "BOLD") = 0 Then

                        Print Results(y).Result

                        'PRINT "TRUE3"

                        Exit For

                    ElseIf InStr(UCase$(FontType$), "ITALIC") And InStr(UCase$(FontType$), "BOLD") And InStr(UCase$(Results(y).Result), "ITALIC") And InStr(UCase$(Results(y).Result), "BOLD") Then

                        Print Results(y).Result

                        'PRINT "TRUE4"

                        Exit For

                    ElseIf InStr(Results(y).Result, Left$(Font$, _InStrRev(Font$, " "))) Then

                        Print Results(y).Result

                        'PRINT "TRUE5"

                        Exit For

                    ElseIf InStr(Results(y).Result, Left$(Font$, _InStrRev(Font$, " "))) And InStr(Results(y).Result, FontType$) Then

                        Print Results(y).Result

                        'PRINT "TRUE5"

                        Exit For

                    End If

                Next

            End If

            If LastDitchEffort$ <> "" Then

                selectedfont$ = fontlist(Array_String.FirstOrDefault(fontlist(), LastDitchEffort$, 1))

            Else

                selectedfont$ = fontlist(Array_String.FirstOrDefault(fontlist(), Results(y).Result, 1))

            End If

            FontName$ = Left$(selectedfont$, InStr(selectedfont$, "=") - 1)

            selectedfont$ = Right$(selectedfont$, Len(selectedfont$) - InStr(selectedfont$, "="))

            If selectedfont$ <> "" Then

                fontpath$ = Environ$("SYSTEMROOT") + "\Fonts\"

                font& = _LoadFont(fontpath$ + selectedfont$, PointSize&)

                If InStr(UCase$(FontType$), "BOLD") And InStr(UCase$(FontType$), "ITALIC") And InStr(UCase$(FontType$), "EXTRA") = 0 And InStr(UCase$(FontType$), "ULTRA") = 0 Then ' AND INSTR(UCASE$(FontType$), "DEMI") = 0

                    font& = _LoadFont(fontpath$ + selectedfont$, PointSize&, "BOLD,ITALIC")

                ElseIf InStr(UCase$(FontType$), "BOLD") And InStr(UCase$(FontType$), "ITALIC") = 0 And InStr(UCase$(FontType$), "EXTRA") = 0 And InStr(UCase$(FontType$), "ULTRA") = 0 Then ' AND INSTR(UCASE$(FontType$), "DEMI") = 0 THEN

                    font& = _LoadFont(fontpath$ + selectedfont$, PointSize&, "BOLD")

                ElseIf InStr(UCase$(FontType$), "ITALIC") And InStr(UCase$(FontType$), "BOLD") = 0 Then

                    font& = _LoadFont(fontpath$ + selectedfont$, PointSize&, "ITALIC")

                Else

                    font& = _LoadFont(fontpath$ + selectedfont$, PointSize&)

                End If

                If font& > 0 Then

                    Color FontColor&

                    LoadFont = font&

                Else

                    LoadFont = 0

                End If

            End If

        End If

    End Function

    Function LastDitch$ (fontlist() As String, Font As String)

        Dim searchFont As String

        For i = 1 To Len(Font$)

            searchFont = Font

            searchFont = String.Insert(searchFont, " ", i)

            a = Array_String.FirstOrDefault(fontlist(), searchFont, 1)

            If a > 0 Then

                Exit For

            End If

        Next

        LastDitch$ = fontlist(a)

    End Function

    $If STRINGMETH = UNDEFINED Then

        $Let STRINGMETH = TRUE

        Type Results

            SearchArrayPosition As Long

            Result As String

        End Type

        Function String.Trim$ (trimString As String)

            trimString = LTrim$(RTrim$(trimString))

            String.Trim = trimString

        End Function

        Function String.Insert$ (toChange As String, insert As String, position As Integer)

            newchange$ = toChange

            newchange$ = Mid$(newchange$, 1, position - 1) + insert + Mid$(newchange$, position, Len(newchange$) - position + 1)

            String.Insert = newchange$

        End Function

        Function Array_String.FindAny (SearchArray() As String, SearchString As String, Results() As Results, explicit As Integer)

            For i = LBound(SearchArray) To UBound(SearchArray)

                If explicit = 0 Then

                    If InStr(SearchArray(i), SearchString) Then

                        ReDim _Preserve Results(x) As Results

                        Results(x).Result = SearchArray(i)

                        Results(x).SearchArrayPosition = i

                        x = x + 1

                    End If

                ElseIf explicit = 1 Then

                    If SearchArray(i) = SearchString Then

                        ReDim _Preserve Results(x) As Results

                        Results(x).Result = SearchArray(i)

                        Results(x).SearchArrayPosition = i

                        x = x + 1

                    End If

                End If

            Next

            Array_String.FindAny = x

        End Function

        Function Array_String.FirstOrDefault (SearchArray() As String, SearchString As String, contains As Integer)

            For i = LBound(SearchArray) To UBound(SearchArray)

                If contains = 1 Then

                    If InStr(SearchArray(i), SearchString) Then

                        Array_String.FirstOrDefault = i

                        Exit Function

                    End If

                ElseIf contains = 0 Then

                    If SearchArray(i) = SearchString Then

                        Array_String.FirstOrDefault = i

                        Exit Function

                    End If

                End If

            Next

        End Function

    $End If

$End If