phone number to words

[bplus]

reply to @Pete last reply

pretty sure the method i outlined above is quicker, the file is ready already in reply #4

the flaw of this idea is that there are no numbers assigned for 0 and 1

BTW here is code i used to make the file:

Code: (Select All)

_Title "Make 7 letter Phone Words txt file"
Type WN
    As String * 7 W, N
End Type
Dim wdList(1 To 24029) As WN
Open "7 Letter Words.txt" For Input As #1
For i = 1 To 24029
    Input #1, wdList(i).W
    wdList(i).N = W2N$(wdList(i).W)
    'Print wdList(i).N, wdList(i).W
    'Sleep
Next
Close #1
QuickSort 1, 24029, wdList()
'For i = 1 To 20
'    Print wdList(i).N, wdList(i).W
'Next
Open "7 Letter Phone Words.txt" For Output As #1
For i = 1 To 24029
    Print #1, wdList(i).N, wdList(i).W
Next
Close #1
Print "number to word file is ready"

Function W2N$ (w$)
    For i = 1 To Len(w$)
        Select Case Asc(UCase$(w$), i)
            Case 65 To 67: d$ = "2" ' ABC
            Case 68 To 70: d$ = "3" ' DEF
            Case 71 To 73: d$ = "4" ' GHI
            Case 74 To 76: d$ = "5" ' JKL
            Case 77 To 79: d$ = "6" ' MNO
            Case 80 To 83: d$ = "7" ' PQRS
            Case 84 To 86: d$ = "8" ' TUV
            Case 87 To 90: d$ = "9" ' WXYZ
        End Select
        rtn$ = rtn$ + d$
    Next
    W2N$ = rtn$
End Function

Sub QuickSort (start As Long, finish As Long, array() As WN)
    Dim Hi As Long, Lo As Long, Middle$
    Hi = finish: Lo = start
    Middle$ = array((Lo + Hi) / 2).N 'find middle of array
    Do
        Do While array(Lo).N < Middle$: Lo = Lo + 1: Loop
        Do While array(Hi).N > Middle$: Hi = Hi - 1: Loop
        If Lo <= Hi Then
            Swap array(Lo), array(Hi)
            Lo = Lo + 1: Hi = Hi - 1
        End If
    Loop Until Lo > Hi
    If Hi > start Then QuickSort start, Hi, array()
    If Lo < finish Then QuickSort Lo, finish, array()
End Sub