Alphabet Buttons

This is a simple demo showing how to work with arrays and a listbox.

' ALPHABET BUTTONS 5000
 
' "Quit" subs by Janet Terra
' Random name generator inspired by the "Buzz phrase generator" by JohnnyD
 
    Dim masterList$(5000)
    Dim displayList$(5000)
    Dim nameCount(26)
 
    Global sortem$, report
 
    displayList$(1) = "  Generating 5000 names" 'Always explain the delay
    displayList$(2) = "   and loading arrays."
    displayList$(3) = "      Please wait!"
 
    Nomainwin
    Stylebits #main, 0,_WS_MAXIMIZEBOX,0,0
    WindowWidth = 230
    WindowHeight = 390
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)
 
    Menu #main, "&File", "E&xit", quitByMenu
 
    Listbox #main.namesList, displayList$(, showName, 15, 5, 195, 248
    Button #main.showAll, "Show All", show5K, UL, 15, 292,  60,  25
    Button #main.addAll, "Report", showReport, UL, 83, 292,  60,  25
    Button #main.exit, "Quit", quit, UL, 150, 292,  60,  25
 
    Button #main.A, "A", selA, UL, 15, 255,  15,  15
    Button #main.B, "B", selB, UL, 30, 255,  15,  15
    Button #main.C, "C", selC, UL, 45, 255,  15,  15
    Button #main.D, "D", selD, UL, 60, 255,  15,  15
    Button #main.E, "E", selE, UL, 75, 255,  15,  15
    Button #main.F, "F", selF, UL, 90, 255,  15,  15
    Button #main.G, "G", selG, UL, 105, 255,  15,  15
    Button #main.H, "H", selH, UL, 120, 255,  15,  15
    Button #main.I, "I", selI, UL, 135, 255,  15,  15
    Button #main.J, "J", selJ, UL, 150, 255,  15,  15
    Button #main.K, "K", selK, UL, 165, 255,  15,  15
    Button #main.L, "L", selL, UL, 180, 255,  15,  15
    Button #main.M, "M", selM, UL, 195, 255,  15,  15
 
    Button #main.N, "N", selN, UL, 15, 270,  15,  15
    Button #main.O, "O", selO, UL, 30, 270,  15,  15
    Button #main.P, "P", selP, UL, 45, 270,  15,  15
    Button #main.Q, "Q", selQ, UL, 60, 270,  15,  15
    Button #main.R, "R", selR, UL, 75, 270,  15,  15
    Button #main.S, "S", selS, UL, 90, 270,  15,  15
    Button #main.T, "T", selT, UL, 105, 270,  15,  15
    Button #main.U, "U", selU, UL, 120, 270,  15,  15
    Button #main.V, "V", selV, UL, 135, 270,  15,  15
    Button #main.W, "W", selW, UL, 150, 270,  15,  15
    Button #main.X, "X", selX, UL, 165, 270,  15,  15
    Button #main.Y, "Y", selY, UL, 180, 270,  15,  15
    Button #main.Z, "Z", selZ, UL, 195, 270,  15,  15
 
      TextboxColor$ = "buttonface"
    Textbox #main.statusLabel, 1, 323,  47,  20
      Stylebits #main.statusLabel, _ES_READONLY, 0, 0, 0
    Textbox #main.status, 48, 323, 173, 20
      Stylebits #main.status, _ES_READONLY, 0, 0, 0
 
    Open "Alphabet Buttons 5000" For Window As #main
        Print #main, "Trapclose quit"
        Print #main.namesList, "Font Courier_New 9"
        Print #main.namesList, "singleclickselect"
        Print #main.showAll, "!Font Arial_10"
        Print #main.addAll, "!Font Arial_10"
        Print #main.exit, "!Font Arial_10"
        Print #main.statusLabel, "!font arial 8";
        Print #main.statusLabel, "Status:"
        Print #main.status, "!font arial 8";
        Print #main.status, "Loading........"
 
    Call gerenateNames$
    Sort masterList$(), 1, 5000
    Call show5K handle$
    Wait
 
Sub show5K handle$
    report = 0
    For x = 1 To 5000
        displayList$(x) = masterList$(x) 'copy contents of masterList$() to displayList$()
    Next x
    Print #main.namesList, "reload"
    Print #main.status, "Displaying 5000 names."
End Sub
 
Sub showName handle$
    Print #main.namesList, "selection? selected$"
    If report <> 1 Then Print #main.status, "Name: "; selected$
End Sub
 
Sub showReport handle$
    Redim displayList$(5000)
    displayList$(1) = "  Counting names and" 'Always explain the delay
    displayList$(2) = "   preparing report."
    displayList$(3) = "     Please wait!"
    Print #main.namesList, "reload"
    Print #main.status, "Preparing report........"
 
    report = 1  'Set flag to prevent display of report lines in status bar.
    totalNames = 0
    reference$ = "A B C D E F G H I J K L M N O P Q R S T U V W X Y Z"
    For x = 1 to 26
        numNames = 0
        sortem$ = word$(reference$, x)
        For y = 1 To 5000
            If left$(masterList$(y),1) = sortem$ Then numNames = numNames + 1
        Next y
        nameCount(x) = numNames
        totalNames = totalNames + numNames
    Next x
 
    Redim displayList$(5000)
    displayList$(1) = "         REPORT"
    For x = 1 to 13
        displayList$(x+1) = "  " + word$(reference$, x) + " = " + Str$(nameCount(x)) + _
            "      " + word$(reference$,x+13) + " = " + Str$(nameCount(x+13))
    Next x
    displayList$(15) = "   TOTAL NAMES = " + Str$(totalNames)
    Print #main.namesList, "reload"
    Print #main.status, "Displaying report."
End Sub
 
Sub filterList handle$
    report = 0
    numNames = 0
    Redim displayList$(5000)
    For x = 1 To 5000
        If left$(masterList$(x),1) = sortem$ Then
            displayList$(x) = masterList$(x)
            numNames = numNames + 1
        End If
    Next x
    Print #main.namesList, "reload"
    Print #main.status, "Displaying "; numNames; " ("; sortem$; ") names."
End Sub
 
Sub quit handle$
    Close #main
    End
End Sub
 
Sub quitByMenu
    Call quit "#main"
End Sub
 
' Generate 5,000 fictious names
Sub gerenateNames$
    a1$ = "A B C D E F G H I J K L M N O P Qu R S T U V W X Y Z"
    a2$ = "b d ck l m n p r sh t v"
    b1$ = "ally exter orbin echell alker olthar insero omestad etcher ashen anovich ordemberg atwood "
    b2$ = "eston arlington eckenstein obuano auld orlique ahr ikowski oster inston inland arroll anettel"
        b3$ = b1$ + b2$
    c$ = "Alice John Penny George Mary Bill Ann Tom Lucy David Jane Juan Wendy Xavier Ruth Bob Cora Leon "
    d$ = "Laura Steve Nancy Matt Kelly Peter Joanne Ivan Betty Lewis Cathy Patrick Phyllis Paul Helen Keith"
        e$ = c$ + d$
 
    For x = 1 To 5000
        f$ = word$(a1$,int(rnd(1)*26)+1," ") 'pick first letter of surname
        If f$ = "A" Or f$ = "E" Or f$ = "I" Or f$ = "O" Or f$ = "U" Then 'if vowel, add consonant
            f$ = f$ + word$(a2$,int(rnd(1)*11)+1," ")
        End If
        g$ = word$(b3$,int(rnd(1)*26)+1," ") 'pick remainder of surname
        h$ = word$(e$,int(rnd(1)*34)+1," ")  'pick first name
        i$ = left$(word$(a1$,int(rnd(1)*26)+1," "),1)  'pick middle initial
        masterList$(x) = f$ + g$ + ", " + h$ + " " + i$ 'assign full name to masterList$()
    Next x
End Sub
 
Sub selA handle$
    sortem$ = "A": Call filterList handle$
End Sub
 
Sub selB handle$
    sortem$ = "B": Call filterList handle$
End Sub
 
Sub selC handle$
    sortem$ = "C": Call filterList handle$
End Sub
 
Sub selD handle$
    sortem$ = "D": Call filterList handle$
End Sub
 
Sub selE handle$
    sortem$ = "E": Call filterList handle$
End Sub
 
Sub selF handle$
    sortem$ = "F": Call filterList handle$
End Sub
 
Sub selG handle$
    sortem$ = "G": Call filterList handle$
End Sub
 
Sub selH handle$
    sortem$ = "H": Call filterList handle$
End Sub
 
Sub selI handle$
    sortem$ = "I": Call filterList handle$
End Sub
 
Sub selJ handle$
    sortem$ = "J": Call filterList handle$
End Sub
 
Sub selK handle$
    sortem$ = "K": Call filterList handle$
End Sub
 
Sub selL handle$
    sortem$ = "L": Call filterList handle$
End Sub
 
Sub selM handle$
    sortem$ = "M": Call filterList handle$
End Sub
 
Sub selN handle$
    sortem$ = "N": Call filterList handle$
End Sub
 
Sub selO handle$
    sortem$ = "O": Call filterList handle$
End Sub
 
Sub selP handle$
    sortem$ = "P": Call filterList handle$
End Sub
 
Sub selQ handle$
    sortem$ = "Q": Call filterList handle$
End Sub
 
Sub selR handle$
    sortem$ = "R": Call filterList handle$
End Sub
 
Sub selS handle$
    sortem$ = "S": Call filterList handle$
End Sub
 
Sub selT handle$
    sortem$ = "T": Call filterList handle$
End Sub
 
Sub selU handle$
    sortem$ = "U": Call filterList handle$
End Sub
 
Sub selV handle$
    sortem$ = "V": Call filterList handle$
End Sub
 
Sub selW handle$
    sortem$ = "W": Call filterList handle$
End Sub
 
Sub selX handle$
    sortem$ = "X": Call filterList handle$
End Sub
 
Sub selY handle$
    sortem$ = "Y": Call filterList handle$
End Sub
 
Sub selZ handle$
    sortem$ = "Z": Call filterList handle$
End Sub
 

jimbird