QB64/InForm
QB64/InForm
1
1
Fork 0
mirror of https://github.com/FellippeHeitor/InForm.git synced 2025-01-15 11:59:34 +00:00
Code Issues Releases Wiki Activity

Fixes font list stuck in textbox mode for built-in fonts. Closes #105.

Browse source
This commit is contained in:
FellippeHeitor 2020-02-16 19:13:05 -03:00
parent 666449f390
commit ae63d07dc9
1 changed files with 21 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
InForm/UiEditor.bas
View file

@ -231,7 +231,7 @@ $IF WIN THEN
FUNCTION SetForegroundWindow& (BYVAL hWnd AS LONG) FUNCTION SetForegroundWindow& (BYVAL hWnd AS LONG)
END DECLARE END DECLARE
''Registry routines taken from the Wiki: http://www.qb64.net/wiki/index.php/Windows_Libraries#Registered_Fonts ''Registry routines taken from the Wiki: http://www.qb64.org/wiki/Windows_Libraries#Registered_Fonts
''Code courtesy of Michael Calkins ''Code courtesy of Michael Calkins
''winreg.h ''winreg.h
CONST HKEY_CLASSES_ROOT = &H80000000~& CONST HKEY_CLASSES_ROOT = &H80000000~&
@ -1185,6 +1185,12 @@ SUB SelectFontInList (FontSetup$)
EXIT SUB EXIT SUB
END IF END IF
NEXT NEXT
ELSE
IF thisSize% = 8 OR thisSize% = 16 THEN
i = SelectItem(FontList, "Built-in _FONT" + STR$(thisSize%))
BypassShowFontList = False
EXIT SUB
END IF
END IF END IF
'If this line is reached, the currently open form 'If this line is reached, the currently open form
@ -3480,6 +3486,9 @@ SUB __UI_ValueChanged (id AS LONG)
END IF END IF
SendData b$, 41 SendData b$, 41
CASE FontList, FontSizeList CASE FontList, FontSizeList
IF id = FontList AND Control(FontList).Value < 3 THEN
Control(FontSizeList).Value = (Control(FontList).Value * 8) - 7
END IF
b$ = FontFile(Control(FontList).Value) + "," + LTRIM$(STR$(Control(FontSizeList).Value + 7)) b$ = FontFile(Control(FontList).Value) + "," + LTRIM$(STR$(Control(FontSizeList).Value + 7))
b$ = MKL$(LEN(b$)) + b$ b$ = MKL$(LEN(b$)) + b$
SendData b$, 8 SendData b$, 8
@ -4720,9 +4729,13 @@ $IF WIN THEN
bData = SPACE$(&H7FFF) 'arbitrary bData = SPACE$(&H7FFF) 'arbitrary
HasFontList = True HasFontList = True
AddItem FontList, "Built-in _FONT 8"
AddItem FontList, "Built-in _FONT 16"
TotalFontsFound = 2
l = RegOpenKeyExA(Ky, _OFFSET(SubKey), 0, KEY_READ, _OFFSET(hKey)) l = RegOpenKeyExA(Ky, _OFFSET(SubKey), 0, KEY_READ, _OFFSET(hKey))
IF l THEN IF l THEN
HasFontList = False 'HasFontList = False
EXIT SUB EXIT SUB
ELSE ELSE
dwIndex = 0 dwIndex = 0
@ -4732,7 +4745,7 @@ $IF WIN THEN
l = RegEnumValueA(hKey, dwIndex, _OFFSET(Value), _OFFSET(numTchars), 0, _OFFSET(dwType), _OFFSET(bData), _OFFSET(numBytes)) l = RegEnumValueA(hKey, dwIndex, _OFFSET(Value), _OFFSET(numTchars), 0, _OFFSET(dwType), _OFFSET(bData), _OFFSET(numBytes))
IF l THEN IF l THEN
IF l <> ERROR_NO_MORE_ITEMS THEN IF l <> ERROR_NO_MORE_ITEMS THEN
HasFontList = False 'HasFontList = False
EXIT SUB EXIT SUB
END IF END IF
EXIT DO EXIT DO
@ -4845,9 +4858,13 @@ $ELSE
END IF END IF
NEXT NEXT
TotalFontsFound = TotalFontsFound + 2
Text(FontList) = "Built-in _FONT 8" + CHR$(10) + "Built-in _FONT 16" + CHR$(10) + Text(FontList)
Control(FontList).Max = TotalFontsFound
REDIM FontFile(TotalFontsFound) AS STRING REDIM FontFile(TotalFontsFound) AS STRING
IF INSTR(_OS$, "MAC") = 0 THEN FontPath$ = "" ELSE FontPath$ = FontPath$ + "/" IF INSTR(_OS$, "MAC") = 0 THEN FontPath$ = "" ELSE FontPath$ = FontPath$ + "/"
FOR i = 1 TO TotalFontsFound FOR i = 3 TO TotalFontsFound
ThisFont$ = GetItem(FontList, i) ThisFont$ = GetItem(FontList, i)
FontFile(i) = FontPath$ + GetItem(FontList, i) FontFile(i) = FontPath$ + GetItem(FontList, i)
ThisFont$ = LEFT$(ThisFont$, LEN(ThisFont$) - 4) 'Remove extension from list ThisFont$ = LEFT$(ThisFont$, LEN(ThisFont$) - 4) 'Remove extension from list