Font Dialog

[NTech]

Here is a font dialog. Everything but the style works.

Code: Select all

dim fileInfo$(3,3)
dim pathView$(5000)
dim font$(5000)
files "C:\Windodws\Fonts\", "*.ttf", fileInfo$()


    dim file$(2, 2)
    dim fontFull$(5000)
    files "C:\Windows\Fonts\", "*.ttf", file$()

    for i = 1 to val(file$(0, 0))
        fontFull$(i) = file$(i, 0)
        'print file$(i, 0)
    next i

    for j = 1 to val(file$(0, 0))
        name$ = fontFull$(j)
        length = len(name$)
        font$(j) = upper$(left$(name$, length-4))
    next j

dim size$(100)
    for s = 1 to 100
    size$(s) = "";s
    next s

dim style$(4)
style$(0) = "regular"
style$(1) = "bold"
style$(2) = "italic"
style$(3) = "underline"
style$(4) = "strikeout"


global font$, size$, style$

font$ = "ms_sans_serif"
size$ = "0 16"
style$ = ""

    nomainwin

    WindowWidth = 560
    WindowHeight = 410

    listbox #main.fontSelect, font$(, [fontSelect], -2, 1, 144, 380
    listbox #main.sizeSelect, size$(, [fontSize], 142, 1, 72, 380
    statictext #main.statictext3, "Font Preview:", 342, 41, 104, 20
    graphicbox #main.graph, 246, 81, 288, 100
    combobox #main.style, style$(,[style], 246, 250, 288, 50
    button #main.button5, "Accept", [accept], UL, 374, 311, 58, 25
    open "Select Font" for window as #main
    print #main.graph, "fill white; flush"
    print #main, "font ms_sans_serif 0 16"


[main.inputLoop]   'wait here for input event
    wait



[fontSelect]   'Perform action for the listbox named 'fontSelect'
    #main.fontSelect, "selection? font$"
    #main, "font ";font$;" ";size$;" ";style$
    #main, "refresh"

    gosub [draw]
    wait


[fontSize]   'Perform action for the listbox named 'fontSize'
    #main.sizeSelect, "selection? size$"
    temp = val(size$)
    size$ = "0 ";temp
    #main, "font ";font$;" ";size$;" ";style$
    #main, "refresh"

    gosub [draw]
    wait

[style]
    #main.style, "selection? style$"
    if style$ = "Regular" then
    style$ = "" : wait
    end if

    temp$ = style$

    style$ = "[";temp$;"]"

    #main, "font ";font$;" ";size$;" ";style$
    #main, "refresh"
    gosub [draw]

    wait


[accept]   'Perform action for the button named 'button5'
    close #main
    end
    wait


wait

[draw]
print #main.graph, "font ";font$;" ";size$;" ";style$
print #main.graph, "cls"
print #main.graph, "color black"
print #main.graph, "goto 0 55 "
print #main.graph, "down"
print #main.graph, "\ABCDEFGHIJKLMNOPQRSTUVWXYZ"
print #main.graph, "up"
return