Making the Registered Fonts/Font Dialog Box Wiki Example Better

[SpriggsySpriggs]

Here is my addition to the Wiki example for getting the list of registered fonts and displaying a Font Dialog box. Once you pick the font, my special function searches an array containing the registered fonts grabbed from the registry keys and then uses another function of mine to search the array several times until it finds the best (from my perspective) match. I'm sure it is sloppy. I used that source merger program and tried to remove as much extra code as possible and keep from having too many $INCLUDEs being left out so people wouldn't be confused. Anyways, here is the code that I made using the Wiki plus some of my own functions. Feel free to tell me if I have something royally screwed and/or use it however you like!

Code: QB64: [Select]

1. $IF FONTDBI = UNDEFINED THEN
2.     $LET FONTDBI = TRUE
3.     CONST HKEY_CLASSES_ROOT = &H80000000~&
4.     CONST HKEY_CURRENT_USER = &H80000001~&
5.     CONST HKEY_LOCAL_MACHINE = &H80000002~&
6.     CONST HKEY_USERS = &H80000003~&
7.     CONST HKEY_PERFORMANCE_DATA = &H80000004~&
8.     CONST HKEY_CURRENT_CONFIG = &H80000005~&
9.     CONST HKEY_DYN_DATA = &H80000006~&
10.     CONST REG_OPTION_VOLATILE = 1
11.     CONST REG_OPTION_NON_VOLATILE = 0
12.     CONST REG_CREATED_NEW_KEY = 1
13.     CONST REG_OPENED_EXISTING_KEY = 2
14.     CONST REG_NONE = 0
15.     CONST REG_SZ = 1
16.     CONST REG_EXPAND_SZ = 2
17.     CONST REG_BINARY = 3
18.     CONST REG_DWORD_LITTLE_ENDIAN = 4 '   value is defined REG_DWORD in Windows header files
19.     CONST REG_DWORD = 4 '                  32-bit number
20.     CONST REG_DWORD_BIG_ENDIAN = 5 '       some UNIX systems support big-endian architectures
21.     CONST REG_LINK = 6
22.     CONST REG_MULTI_SZ = 7
23.     CONST REG_RESOURCE_LIST = 8
24.     CONST REG_FULL_RESOURCE_DESCRIPTOR = 9
25.     CONST REG_RESOURCE_REQUIREMENTS_LIST = 10
26.     CONST REG_QWORD_LITTLE_ENDIAN = 11 '  64-bit number in little-endian format
27.     CONST REG_QWORD = 11 '                 64-bit number
28.     CONST REG_NOTIFY_CHANGE_NAME = 1
29.     CONST REG_NOTIFY_CHANGE_ATTRIBUTES = 2
30.     CONST REG_NOTIFY_CHANGE_LAST_SET = 4
31.     CONST REG_NOTIFY_CHANGE_SECURITY = 8
32.     CONST KEY_ALL_ACCESS = &HF003F&
33.     CONST KEY_CREATE_LINK = &H0020&
34.     CONST KEY_CREATE_SUB_KEY = &H0004&
35.     CONST KEY_ENUMERATE_SUB_KEYS = &H0008&
36.     CONST KEY_EXECUTE = &H20019&
37.     CONST KEY_NOTIFY = &H0010&
38.     CONST KEY_QUERY_VALUE = &H0001&
39.     CONST KEY_READ = &H20019&
40.     CONST KEY_SET_VALUE = &H0002&
41.     CONST KEY_WOW64_32KEY = &H0200&
42.     CONST KEY_WOW64_64KEY = &H0100&
43.     CONST KEY_WRITE = &H20006&
44.     CONST ERROR_SUCCESS = 0
45.     CONST ERROR_FILE_NOT_FOUND = &H2&
46.     CONST ERROR_INVALID_HANDLE = &H6&
47.     CONST ERROR_MORE_DATA = &HEA&
48.     CONST ERROR_NO_MORE_ITEMS = &H103&
49.     DECLARE DYNAMIC LIBRARY "advapi32"
50.         FUNCTION RegOpenKeyExA& (BYVAL hKey AS _OFFSET, BYVAL lpSubKey AS _OFFSET, BYVAL ulOptions AS _UNSIGNED LONG, BYVAL samDesired AS _UNSIGNED LONG, BYVAL phkResult AS _OFFSET)
51.         FUNCTION RegCloseKey& (BYVAL hKey AS _OFFSET)
52.         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)
53.     END DECLARE
54.     CONST CF_APPLY = &H200& '             Displays Apply button
55.     CONST CF_ANSIONLY = &H400& '          list ANSI fonts only
56.     CONST CF_BOTH = &H3& '                list both Screen and Printer fonts
57.     CONST CF_EFFECTS = &H100& '          Display Underline and Strike Through boxes
58.     CONST CF_ENABLEHOOK = &H8& '          set hook to custom template
59.     CONST CF_ENABLETEMPLATE = &H10& '     enable custom template
60.     CONST CF_ENABLETEMPLATEHANDLE = &H20&
61.     CONST CF_FIXEDPITCHONLY = &H4000& '  list only fixed-pitch fonts
62.     CONST CF_FORCEFONTEXIST = &H10000& '  indicate error when font not listed is chosen
63.     CONST CF_INACTIVEFONTS = &H2000000& ' display hidden fonts in Win 7 only
64.     CONST CF_INITTOLOGFONTSTRUCT = &H40& 'use the structure pointed to by the lpLogFont member
65.     CONST CF_LIMITSIZE = &H2000& '        select font sizes only within nSizeMin and nSizeMax members
66.     CONST CF_NOOEMFONTS = &H800& '        should not allow vector font selections
67.     CONST CF_NOFACESEL = &H80000& '       prevent displaying initial selection in font name combo box.
68.     CONST CF_NOSCRIPTSEL = &H800000& '    Disables the Script combo box
69.     CONST CF_NOSIMULATIONS = &H1000& '    Disables selection of font simulations
70.     CONST CF_NOSIZESEL = &H200000& '     Disables Point Size selection
71.     CONST CF_NOSTYLESEL = &H100000& '     Disables Style selection
72.     CONST CF_NOVECTORFONTS = &H800&
73.     CONST CF_NOVERTFONTS = &H1000000&
74.     CONST CF_OEMTEXT = &H7&
75.     CONST CF_PRINTERFONTS = &H2& '        list fonts only supported by printer associated with the device
76.     CONST CF_SCALABLEONLY = &H20000& '    select only vector fonts, scalable printer fonts, and TrueType fonts
77.     CONST CF_SCREENFONTS = &H1& '        lists only the screen fonts supported by system
78.     CONST CF_SCRIPTSONLY = &H400& '       lists all non-OEM, Symbol and ANSI sets only
79.     CONST CF_SELECTSCRIPT = &H400000& '  can only use set specified in the Scripts combo box
80.     CONST CF_SHOWHELP = &H4& '           displays Help button reference
81.     CONST CF_TTONLY = &H40000& '         True Type only
82.     CONST CF_USESTYLE = &H80& '           copies style data for the user's selection to lpszStyle buffer
83.     CONST CF_WYSIWYG = &H8000& '          only list fonts available on both the printer and display
84.     CONST BOLD_FONTTYPE = &H100&
85.     CONST ITALIC_FONTTYPE = &H200&
86.     CONST PRINTER_FONTTYPE = &H4000&
87.     CONST REGULAR_FONTTYPE = &H400&
88.     CONST SCREEN_FONTTYPE = &H2000&
89.     CONST SIMULATED_FONTTYPE = &H8000&
90.     CONST FW_DONTCARE = 0
91.     CONST FW_THIN = 100
92.     CONST FW_ULTRALIGHT = 200
93.     CONST FW_LIGHT = 300
94.     CONST FW_REGULAR = 400
95.     CONST FW_MEDIUM = 500
96.     CONST FW_SEMIBOLD = 600
97.     CONST FW_BOLD = 700
98.     CONST FW_ULTRABOLD = 800
99.     CONST FW_HEAVY = 900
100.     CONST DEFAULT_CHARSET = 1
101.     CONST LF_DEFAULT = 0
102.     CONST FF_ROMAN = 16
103.     CONST LF_FACESIZE = 32
104.     CONST GMEM_MOVEABLE = &H2
105.     CONST GMEM_ZEROINIT = &H40
106.     DECLARE DYNAMIC LIBRARY "comdlg32"
107.         FUNCTION ChooseFontA& (BYVAL lpcf AS _OFFSET)
108.         FUNCTION CommDlgExtendedError& () '                'dialog box error checking procedure
109.     END DECLARE
110.     TYPE CHOOSEFONT
111.         lStructSize AS _UNSIGNED LONG
112.         hwndOwner AS _OFFSET
113.         HDC AS _OFFSET
114.         lpLogFont AS _OFFSET
115.         iPointSize AS LONG
116.         Flags AS LONG
117.         rgbColors AS _UNSIGNED LONG
118.         lCustData AS _OFFSET
119.         lpfnHook AS _OFFSET
120.         lpTemplateName AS _OFFSET
121.         hInstance AS _OFFSET
122.         lpszStyle AS _OFFSET
123.         nFontType AS LONG '  if used as Unsigned Integer add Integer padder below
124.         nSizeMin AS LONG
125.         nSizeMax AS LONG
126.     END TYPE
127.     TYPE LOGFONT
128.         lfHeight AS LONG
129.         lfWidth AS LONG
130.         lfEscapement AS LONG
131.         lfOrientation AS LONG
132.         lfWeight AS LONG
133.         lfItalic AS _BYTE '    not 0 when user selected
134.         lfUnderline AS _BYTE ' not 0 when user selected
135.         lfStrikeOut AS _BYTE ' not 0 when user selected
136.         lfCharSet AS _BYTE
137.         lfOutPrecision AS _BYTE
138.         lfClipPrecision AS _BYTE
139.         lfQuality AS _BYTE
140.         lfPitchAndFamily AS _BYTE
141.         lfFaceName AS STRING * 32 'contains name listed in dialog
142.     END TYPE
143.     DIM SHARED FontType AS STRING
144.     DIM SHARED PointSize&
145.     DIM SHARED FontColor&
146.     DIM SHARED fontpath AS STRING
147.     DIM SHARED selectedfont AS STRING
148.     DIM SHARED FontName AS STRING
149.     DIM SHARED FontEff AS STRING
150. $END IF
151.  
152. 'MAIN MODULE
153. _TITLE "LoadFont Test with Accurate Search"
154. SCREEN _NEWIMAGE(1280, 720, 32)
155. AGAIN:
156. CLS
157. _FONT16
158. y = CSRLIN
159. x = POS(0)
160. f& = LoadFont
161. IF f& > 0 THEN
162.     _FONT f&
163.     LOCATE 20, x
164.     PRINT "This is "; FontName; ", loaded from "; selectedfont; " in"; PointSize&; "points"
165.     PRINT "Go again? (Y/N)"
166. ELSE
167.     SYSTEM
168. END IF
169. DO
170.     k$ = INKEY$
171.     IF UCASE$(k$) = "Y" THEN
172.         GOTO AGAIN
173.     ELSEIF UCASE$(k$) = "N" THEN
174.         SYSTEM
175.     END IF
176. LOOP UNTIL UCASE$(k$) = "Y" OR UCASE$(k$) = "N"
177. 'END MAIN MODULE
178.  
179. $IF FONTDBM = UNDEFINED THEN
180.     $LET FONTDBM = TRUE
181.     SUB GetFonts
182.         DIM hKey AS _OFFSET
183.         DIM Ky AS _OFFSET
184.         DIM SubKey AS STRING
185.         DIM Value AS STRING
186.         DIM bData AS STRING
187.         DIM t AS STRING
188.         DIM dwType AS _UNSIGNED LONG
189.         DIM numBytes AS _UNSIGNED LONG
190.         DIM numTchars AS _UNSIGNED LONG
191.         DIM l AS LONG
192.         DIM dwIndex AS _UNSIGNED LONG
193.         FONTFILE = FREEFILE
194.         OPEN "F0NTList.INF" FOR OUTPUT AS #FONTFILE 'create a new file for font data
195.         Ky = HKEY_LOCAL_MACHINE
196.         SubKey = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts" + CHR$(0)
197.         Value = SPACE$(261) 'ANSI Value name limit 260 chars + 1 null
198.         bData = SPACE$(&H7FFF) 'arbitrary
199.         l = RegOpenKeyExA(Ky, _OFFSET(SubKey), 0, KEY_READ, _OFFSET(hKey))
200.         IF l THEN
201.         ELSE
202.             dwIndex = 0
203.             DO
204.                 numBytes = LEN(bData)
205.                 numTchars = LEN(Value)
206.                 l = RegEnumValueA(hKey, dwIndex, _OFFSET(Value), _OFFSET(numTchars), 0, _OFFSET(dwType), _OFFSET(bData), _OFFSET(numBytes))
207.                 IF l THEN
208.                     EXIT DO
209.                 ELSE
210.                     PRINT #FONTFILE, LEFT$(Value, numTchars) + "=" + formatData(dwType, numBytes, bData)
211.                 END IF
212.                 dwIndex = dwIndex + 1
213.             LOOP
214.             CLOSE #FONTFILE
215.             l = RegCloseKey(hKey)
216.         END IF
217.     END SUB
218.     FUNCTION whatType$ (dwType AS _UNSIGNED LONG)
219.         SELECT CASE dwType
220.             CASE REG_SZ: whatType = "REG_SZ"
221.             CASE REG_EXPAND_SZ: whatType = "REG_EXPAND_SZ"
222.             CASE REG_BINARY: whatType = "REG_BINARY"
223.             CASE REG_DWORD: whatType = "REG_DWORD"
224.             CASE REG_DWORD_BIG_ENDIAN: whatType = "REG_DWORD_BIG_ENDIAN"
225.             CASE REG_LINK: whatType = "REG_LINK"
226.             CASE REG_MULTI_SZ: whatType = "REG_MULTI_SZ"
227.             CASE REG_RESOURCE_LIST: whatType = "REG_RESOURCE_LIST"
228.             CASE REG_FULL_RESOURCE_DESCRIPTOR: whatType = "REG_FULL_RESOURCE_DESCRIPTOR"
229.             CASE REG_RESOURCE_REQUIREMENTS_LIST: whatType = "REG_RESOURCE_REQUIREMENTS_LIST"
230.             CASE REG_QWORD: whatType = "REG_QWORD"
231.             CASE ELSE: whatType = "unknown"
232.         END SELECT
233.     END FUNCTION
234.     FUNCTION whatKey$ (hKey AS _OFFSET)
235.         SELECT CASE hKey
236.             CASE HKEY_CLASSES_ROOT: whatKey = "HKEY_CLASSES_ROOT"
237.             CASE HKEY_CURRENT_USER: whatKey = "HKEY_CURRENT_USER"
238.             CASE HKEY_LOCAL_MACHINE: whatKey = "HKEY_LOCAL_MACHINE"
239.             CASE HKEY_USERS: whatKey = "HKEY_USERS"
240.             CASE HKEY_PERFORMANCE_DATA: whatKey = "HKEY_PERFORMANCE_DATA"
241.             CASE HKEY_CURRENT_CONFIG: whatKey = "HKEY_CURRENT_CONFIG"
242.             CASE HKEY_DYN_DATA: whatKey = "HKEY_DYN_DATA"
243.         END SELECT
244.     END FUNCTION
245.     FUNCTION formatData$ (dwType AS _UNSIGNED LONG, numBytes AS _UNSIGNED LONG, bData AS STRING)
246.         DIM t AS STRING
247.         DIM ul AS _UNSIGNED LONG
248.         DIM b AS _UNSIGNED _BYTE
249.         SELECT CASE dwType
250.             CASE REG_SZ, REG_EXPAND_SZ, REG_MULTI_SZ
251.                 formatData = LEFT$(bData, numBytes - 1)
252.             CASE REG_DWORD
253.                 t = LCASE$(HEX$(CVL(LEFT$(bData, 4))))
254.                 formatData = "0x" + STRING$(8 - LEN(t), &H30) + t
255.             CASE ELSE
256.                 IF numBytes THEN
257.                     b = ASC(LEFT$(bData, 1))
258.                     IF b < &H10 THEN
259.                         t = t + "0" + LCASE$(HEX$(b))
260.                     ELSE
261.                         t = t + LCASE$(HEX$(b))
262.                     END IF
263.                 END IF
264.                 FOR ul = 2 TO numBytes
265.                     b = ASC(MID$(bData, ul, 1))
266.                     IF b < &H10 THEN
267.                         t = t + " 0" + LCASE$(HEX$(b))
268.                     ELSE
269.                         t = t + " " + LCASE$(HEX$(b))
270.                     END IF
271.                 NEXT
272.                 formatData = t
273.         END SELECT
274.     END FUNCTION
275.     FUNCTION ShowFont$ (hWnd AS _OFFSET)
276.         DIM cf AS CHOOSEFONT
277.         DIM lfont AS LOGFONT
278.         SHARED FontColor&, FontType$, FontEff$, PointSize AS LONG 'shared with main program
279.         lfont.lfHeight = LF_DEFAULT ' determine default height '       set dailog box defaults
280.         lfont.lfWidth = LF_DEFAULT ' determine default width
281.         lfont.lfEscapement = LF_DEFAULT ' angle between baseline and escapement vector
282.         lfont.lfOrientation = LF_DEFAULT ' angle between baseline and orientation vector
283.         lfont.lfWeight = FW_REGULAR ' normal weight i.e. not bold
284.         lfont.lfCharSet = DEFAULT_CHARSET ' use default character set
285.         lfont.lfOutPrecision = LF_DEFAULT ' default precision mapping
286.         lfont.lfClipPrecision = LF_DEFAULT ' default clipping precision
287.         lfont.lfQuality = LF_DEFAULT ' default quality setting
288.         lfont.lfPitchAndFamily = LF_DEFAULT OR FF_ROMAN ' default pitch, proportional with serifs
289.         lfont.lfFaceName = "Calibri" + CHR$(0) ' string must be null-terminated
290.         cf.lStructSize = LEN(cf) ' size of structure
291.         cf.hwndOwner = hWnd ' window opening the dialog box
292.         cf.lpLogFont = _OFFSET(lfont)
293.         cf.iPointSize = 120 ' 12 point font (in units of 1/10 point)
294.         cf.Flags = CF_BOTH OR CF_EFFECTS OR CF_FORCEFONTEXIST OR CF_INITTOLOGFONTSTRUCT OR CF_LIMITSIZE
295.         cf.rgbColors = _RGB(238, 161, 50)
296.         cf.nFontType = REGULAR_FONTTYPE ' regular font type i.e. not bold or anything
297.         cf.nSizeMin = 10 ' minimum point size
298.         cf.nSizeMax = 72 ' maximum point size
299.         IF ChooseFontA&(_OFFSET(cf)) <> 0 THEN '    'Initiate Dialog and Read user selections
300.             ShowFont = LEFT$(lfont.lfFaceName, INSTR(lfont.lfFaceName, CHR$(0)) - 1)
301.             FontColor& = _RGB(_BLUE32(cf.rgbColors), _GREEN32(cf.rgbColors), _RED32(cf.rgbColors))
302.             IF cf.nFontType AND BOLD_FONTTYPE THEN FontType$ = "Bold"
303.             IF cf.nFontType AND ITALIC_FONTTYPE THEN FontType$ = FontType$ + " Italic"
304.             IF cf.nFontType AND REGULAR_FONTTYPE THEN FontType$ = "Regular"
305.             IF lfont.lfUnderline THEN FontEff$ = "Underline"
306.             IF lfont.lfStrikeOut THEN FontEff$ = FontEff$ + "Strikeout"
307.             PointSize = cf.iPointSize \ 10
308.         ELSE
309.             ShowFont = ""
310.         END IF
311.     END FUNCTION
312.     FUNCTION LoadFont&
313.         Font$ = ShowFont(_WINDOWHANDLE) '           call Dialog Box and get the font selection
314.         IF Font$ <> "" THEN
315.             F = FREEFILE
316.             DIM fontlist(n) AS STRING
317.             OPEN "F0NTList.INF" FOR BINARY AS #F
318.             IF LOF(F) = 0 THEN GetFonts
319.             DO
320.                 IF NOT EOF(F) THEN
321.                     LINE INPUT #F, regfont$
322.                     i = i + 1
323.                     REDIM _PRESERVE fontlist(i) AS STRING
324.                     fontlist(i) = regfont$
325.                 END IF
326.             LOOP UNTIL EOF(F)
327.             CLOSE #F
328.             REDIM Results(0) AS Results
329.                         FFont$ = Font$
330.             a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 1) 'test1
331.             PRINT "="; Font$; " "; FontType$
332.             IF a > 1 OR a = 0 THEN
333.                 PRINT "Couldn't find it with first search, broadening"
334.                 a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 0) 'test2
335.                 PRINT "%"; Font$; " "; FontType$
336.                 IF a = 0 THEN
337.                     PRINT "Couldn't find it with second search, broadening"
338.                     IF LEFT$(Font$, INSTR(Font$, " ")) = "" THEN
339.                         a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 1) 'test3
340.                         PRINT "="; String.Trim(Font$ + " " + FontType$)
341.                     ELSE
342.                         a = Array_String.FindAny(fontlist(), LEFT$(Font$, INSTR(Font$, " ")) + FontType$, Results(), 1) 'test3
343.                         PRINT "="; LEFT$(Font$, INSTR(Font$, " ")) + FontType$
344.                     END IF
345.                     IF a = 0 THEN
346.                         PRINT "Couldn't find it with third search, broadening"
347.                         IF LEFT$(Font$, INSTR(Font$, " ")) = "" THEN
348.                             a = Array_String.FindAny(fontlist(), String.Trim(Font$ + " " + FontType$), Results(), 0) 'test4
349.                             PRINT "%"; String.Trim(Font$ + " " + FontType$)
350.                         ELSE
351.                             a = Array_String.FindAny(fontlist(), LEFT$(Font$, INSTR(Font$, " ")) + FontType$, Results(), 0) 'test4
352.                             PRINT "%"; LEFT$(Font$, INSTR(Font$, " ")) + FontType$
353.                         END IF
354.                         IF a = 0 THEN
355.                             PRINT "Couldn't find it with fourth search, broadening"
356.                             a = Array_String.FindAny(fontlist(), Font$, Results(), 1) 'test5
357.                             PRINT "="; Font$
358.                             IF a = 0 THEN
359.                                 PRINT "Couldn't find it with fifth search, broadening"
360.                                 a = Array_String.FindAny(fontlist(), Font$, Results(), 0) 'test6
361.                                 PRINT "%"; Font$
362.                                 IF a = 0 THEN
363.                                     PRINT "Couldn't find it with sixth search, broadening"
364.                                     IF LEFT$(Font$, INSTR(Font$, " ")) = "" THEN
365.                                         a = Array_String.FindAny(fontlist(), String.Trim(Font$), Results(), 1) 'test7
366.                                         PRINT "="; String.Trim(Font$)
367.                                     ELSE
368.                                         a = Array_String.FindAny(fontlist(), LEFT$(Font$, INSTR(Font$, " ")), Results(), 1) 'test7
369.                                         PRINT "="; LEFT$(Font$, INSTR(Font$, " "))
370.                                     END IF
371.                                     IF a = 0 THEN
372.                                         PRINT "Couldn't find it with seventh search, broadening"
373.                                         IF LEFT$(Font$, INSTR(Font$, " ")) = "" THEN
374.                                             a = Array_String.FindAny(fontlist(), String.Trim(Font$), Results(), 0) 'test8
375.                                             PRINT "%"; String.Trim(Font$)
376.                                         ELSE
377.                                             a = Array_String.FindAny(fontlist(), LEFT$(Font$, INSTR(Font$, " ")), Results(), 0) 'test8
378.                                             PRINT "%"; LEFT$(Font$, INSTR(Font$, " "))
379.                                         END IF
380.                                         IF a = 0 THEN
381.                                             PRINT "Couldn't find a suitable font matching that search term in all 8 searches"
382.                                             PRINT "Last ditch effort to find font"
383.                                             IF LEFT$(Font$, INSTR(Font$, " ")) = "" THEN
384.                                                 LastDitchEffort$ = LastDitch(fontlist(), String.Trim(Font$)) 'test9
385.                                             ELSE
386.                                                 LastDitchEffort$ = LastDitch(fontlist(), LEFT$(Font$, INSTR(Font$, " "))) 'test9
387.                                             END IF
388.                                             IF LastDitchEffort$ = "" THEN
389.                                                 PRINT "Cannot find the font."
390.                                                 PRINT "Ending"
391.                                                 END
392.                                             ELSE
393.                                                 PRINT LastDitchEffort$
394.                                             END IF
395.                                         END IF
396.                                     END IF
397.                                 END IF
398.                             END IF
399.                         END IF
400.                     END IF
401.                 END IF
402.             END IF
403.             IF LastDitchEffort$ = "" THEN
404.                 FOR y = LBOUND(Results) TO UBOUND(Results)
405.                     IF INSTR(Results(y).Result, LEFT$(Font$, _INSTRREV(Font$, " "))) AND INSTR(UCASE$(FontType$), "ITALIC") = 0 AND INSTR(UCASE$(FontType$), "BOLD") = 0 THEN
406.                         PRINT Results(y).Result
407.                         'PRINT "TRUE1"
408.                         EXIT FOR
409.                     ELSEIF INSTR(Results(y).Result, Font$ + " " + FontType$) THEN
410.                         PRINT Results(y).Result
411.                         'PRINT "TRUE2"
412.                         EXIT FOR
413.                     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
414.                         PRINT Results(y).Result
415.                         'PRINT "TRUE3"
416.                         EXIT FOR
417.                     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
418.                         PRINT Results(y).Result
419.                         'PRINT "TRUE4"
420.                         EXIT FOR
421.                     ELSEIF INSTR(Results(y).Result, LEFT$(Font$, _INSTRREV(Font$, " "))) THEN
422.                         PRINT Results(y).Result
423.                         'PRINT "TRUE5"
424.                         EXIT FOR
425.                     ELSEIF INSTR(Results(y).Result, LEFT$(Font$, _INSTRREV(Font$, " "))) AND INSTR(Results(y).Result, FontType$) THEN
426.                         PRINT Results(y).Result
427.                         'PRINT "TRUE5"
428.                         EXIT FOR
429.                     END IF
430.                 NEXT
431.             END IF
432.             IF LastDitchEffort$ <> "" THEN
433.                 selectedfont$ = fontlist(Array_String.FirstOrDefault(fontlist(), LastDitchEffort$, 1))
434.             ELSE
435.                 selectedfont$ = fontlist(Array_String.FirstOrDefault(fontlist(), Results(y).Result, 1))
436.             END IF
437.             FontName$ = LEFT$(selectedfont$, INSTR(selectedfont$, "=") - 1)
438.             selectedfont$ = RIGHT$(selectedfont$, LEN(selectedfont$) - INSTR(selectedfont$, "="))
439.             IF selectedfont$ <> "" THEN
440.                 fontpath$ = ENVIRON$("SYSTEMROOT") + "\Fonts\"
441.                 font& = _LOADFONT(fontpath$ + selectedfont$, PointSize&)
442.                 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
443.                     font& = _LOADFONT(fontpath$ + selectedfont$, PointSize&, "BOLD,ITALIC")
444.                 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
445.                     font& = _LOADFONT(fontpath$ + selectedfont$, PointSize&, "BOLD")
446.                 ELSEIF INSTR(UCASE$(FontType$), "ITALIC") AND INSTR(UCASE$(FontType$), "BOLD") = 0 THEN
447.                     font& = _LOADFONT(fontpath$ + selectedfont$, PointSize&, "ITALIC")
448.                 ELSE
449.                     font& = _LOADFONT(fontpath$ + selectedfont$, PointSize&)
450.                 END IF
451.                 IF font& > 0 THEN
452.                     COLOR FontColor&
453.                     LoadFont = font&
454.                 ELSE
455.                     LoadFont = 0
456.                 END IF
457.             END IF
458.         END IF
459.     END FUNCTION
460.     FUNCTION LastDitch$ (fontlist() AS STRING, Font AS STRING)
461.         DIM searchFont AS STRING
462.         FOR i = 1 TO LEN(Font$)
463.             searchFont = Font
464.             searchFont = String.Insert(searchFont, " ", i)
465.             a = Array_String.FirstOrDefault(fontlist(), searchFont, 1)
466.             IF a > 0 THEN
467.                 EXIT FOR
468.             END IF
469.         NEXT
470.         LastDitch$ = fontlist(a)
471.     END FUNCTION
472.     $IF STRINGMETH = UNDEFINED THEN
473.         $LET STRINGMETH = TRUE
474.         TYPE Results
475.             SearchArrayPosition AS LONG
476.             Result AS STRING
477.         END TYPE
478.         FUNCTION String.Trim$ (trimString AS STRING)
479.             trimString = LTRIM$(RTRIM$(trimString))
480.             String.Trim = trimString
481.         END FUNCTION
482.         FUNCTION String.Insert$ (toChange AS STRING, insert AS STRING, position AS INTEGER)
483.             newchange$ = toChange
484.             newchange$ = MID$(newchange$, 1, position - 1) + insert + MID$(newchange$, position, LEN(newchange$) - position + 1)
485.             String.Insert = newchange$
486.         END FUNCTION
487.         FUNCTION Array_String.FindAny (SearchArray() AS STRING, SearchString AS STRING, Results() AS Results, explicit AS INTEGER)
488.             FOR i = LBOUND(SearchArray) TO UBOUND(SearchArray)
489.                 IF explicit = 0 THEN
490.                     IF INSTR(SearchArray(i), SearchString) THEN
491.                         REDIM _PRESERVE Results(x) AS Results
492.                         Results(x).Result = SearchArray(i)
493.                         Results(x).SearchArrayPosition = i
494.                         x = x + 1
495.                     END IF
496.                 ELSEIF explicit = 1 THEN
497.                     IF SearchArray(i) = SearchString THEN
498.                         REDIM _PRESERVE Results(x) AS Results
499.                         Results(x).Result = SearchArray(i)
500.                         Results(x).SearchArrayPosition = i
501.                         x = x + 1
502.                     END IF
503.                 END IF
504.             NEXT
505.             Array_String.FindAny = x
506.         END FUNCTION
507.         FUNCTION Array_String.FirstOrDefault (SearchArray() AS STRING, SearchString AS STRING, contains AS INTEGER)
508.             FOR i = LBOUND(SearchArray) TO UBOUND(SearchArray)
509.                 IF contains = 1 THEN
510.                     IF INSTR(SearchArray(i), SearchString) THEN
511.                         Array_String.FirstOrDefault = i
512.                         EXIT FUNCTION
513.                     END IF
514.                 ELSEIF contains = 0 THEN
515.                     IF SearchArray(i) = SearchString THEN
516.                         Array_String.FirstOrDefault = i
517.                         EXIT FUNCTION
518.                     END IF
519.                 END IF
520.             NEXT
521.         END FUNCTION
522.     $END IF
523. $END IF