bads beds bids bods buds
bags begs bigs bogs bugs
ball bell bill boll bull
band bend bind bond bund
bats bets bits bots buts
care cere cire core cure
cate cete cite cote cute
dare dere dire dore dure
fans fens fins fons funs
hack heck hick hock huck
haed heed hied hoed hued
hats hets hits hots huts
last lest list lost lust
mags megs migs mogs mugs
mall mell mill moll mull
mare mere mire more mure
mass mess miss moss muss
mate mete mite mote mute
nabs nebs nibs nobs nubs
pack peck pick pock puck
pale pele pile pole pule
pans pens pins pons puns
paps peps pips pops pups
pats pets pits pots puts
rack reck rick rock ruck
rams rems rims roms rums
tale tele tile tole tule
tans tens tins tons tuns
tats tets tits tots tuts
A more extensive list can be found in Dej Mar's post.
DefDbl A-Z
Dim crlf$
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr(13) + Chr(10)
Open "c:\\words\\words4.txt" For Binary As #1
w0$ = " "
Do
Get #1, , w0$
If EOF(1) Then Exit Do
If InStr(w0$, "a") > 0 Then
For apos = 1 To 4
If Mid(w0$, apos, 1) = "a" Then
good = 1
For i = 1 To 4
w$ = w0$
Mid(w, apos, 1) = Mid("eiou", i, 1)
If isWord(w) = 0 Then good = 0: Exit For
Next
If good Then
Text1.Text = Text1.Text & w0
For i = 1 To 4
w$ = w0$
Mid(w, apos, 1) = Mid("eiou", i, 1)
Text1.Text = Text1.Text & " " & w
Next
Text1.Text = Text1.Text & crlf
End If
End If
Next
End If
DoEvents
Loop
Close 1
Text1.Text = Text1.Text & crlf & " done"
End Sub
Function isWord(w$)
n = Len(w$)
w1$ = Space$(n)
Open "c:\\words\\words" + LTrim$(Str$(n)) + ".txt" For Binary As #2
l = LOF(2) / n
low = 1: high = l
Do
DoEvents
middle = Int((low + high) / 2)
Get #2, (middle - 1) * n + 1, w1$
If w1$ = w$ Then isWord = 1: Close 2: Exit Function
If w1$ < w$ Then low = middle + 1 Else high = middle - 1
Loop Until low > high
isWord = 0
Close 2
End Function
|
