home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / Spell_chec183645132005.psc / mainbas.bas < prev    next >
BASIC Source File  |  2005-01-02  |  8KB  |  280 lines
  1. Attribute VB_Name = "modMain"
  2.  
  3. 'Option Explicit
  4.  
  5. Public alphabetWords(26) As New CollStrC
  6. Public Full_list_count As Long
  7. Public Full_list(400000) As String ' replace the 40000 with the the rough amout of words in the databse + 10,000
  8.  
  9. 'Public Declare Function GetInputState Lib "user32" () As Long
  10.  
  11. Public Sub Main()
  12.  Dim n As Integer
  13.  
  14.  For n = 0 To 26
  15.    Set alphabetWords(n) = New CollStrC
  16.  Next n
  17.  
  18.  LoadWords
  19.  LoadMoreWords
  20.  frmYourProgGoesHere.Show
  21.  
  22. End Sub
  23. Public Sub closer()
  24.  Dim n As Integer
  25.  
  26.  For n = 0 To 26
  27.    Set alphabetWords(n) = Nothing
  28.  Next n
  29.  
  30. For i = 0 To UBound(Full_list)
  31.     Full_list(i) = ""
  32. Next
  33.  
  34.  Unload Form1
  35.  Unload frmSpelling
  36.  Unload frmYourProgGoesHere
  37. End Sub
  38.  
  39. Public Sub LoadWords()
  40.  
  41. On Error Resume Next
  42.  
  43. Dim a As Long
  44. Dim ds As Long
  45. Dim awrds As Integer
  46. Dim last_awrds As Integer
  47. Dim word As String
  48. Dim meaning As String
  49. Dim intFileNum  As Long
  50. Dim strSpell As String
  51.  
  52. Form1.Show
  53. DoEvents
  54. ds = GetSetting(App.EXEName, "Words", "Count", "25000")
  55.  
  56. intFileNum = FreeFile
  57. Open App.Path & "\word.lst" For Input As #intFileNum
  58.  
  59.   Do While Not EOF(intFileNum)
  60.       Line Input #intFileNum, strSpell
  61.  
  62.       If Len(strSpell) > 0 Then
  63.           'If InStr(1, strSpell, ":") > 0 Then
  64.           '   word = Left$(strSpell, InStr(1, strSpell, ":") - 1)
  65.           '   meaning = Right$(strSpell, Len(strSpell) - InStr(1, strSpell, ":"))
  66.           'Else
  67.              word = strSpell
  68.             meaning = " N\A"
  69.          'End If
  70.                 
  71.        Select Case UCase(Left$(word, 1))
  72.               Case "A": awrds = 0
  73.               Case "B": awrds = 1
  74.               Case "C": awrds = 2
  75.               Case "D": awrds = 3
  76.               Case "E": awrds = 4
  77.               Case "F": awrds = 5
  78.               Case "G": awrds = 6
  79.               Case "H": awrds = 7
  80.               Case "I": awrds = 8
  81.               Case "J": awrds = 9
  82.               Case "K": awrds = 10
  83.               Case "L": awrds = 11
  84.               Case "M": awrds = 12
  85.               Case "N": awrds = 13
  86.               Case "O": awrds = 14
  87.               Case "P": awrds = 15
  88.               Case "Q": awrds = 16
  89.               Case "R": awrds = 17
  90.               Case "S": awrds = 18
  91.               Case "T": awrds = 19
  92.               Case "U": awrds = 20
  93.               Case "V": awrds = 21
  94.               Case "W": awrds = 22
  95.               Case "X": awrds = 23
  96.               Case "Y": awrds = 24
  97.               Case "Z": awrds = 25
  98.               'Case Else: awrds = 26
  99.         End Select
  100.     
  101.             If Not awrds = last_awrds Then
  102.                 Form1.Label1.Caption = "Loading" & "... " & UCase(Left$(word, 1))
  103.                 last_awrds = awrds
  104.             End If
  105.     
  106.              alphabetWords(awrds).Add word, meaning
  107.              
  108.              If Not alphabetWords(awrds).Status = estrStatus.NameExists Or _
  109.                         Not alphabetWords(awrds).Status = estrStatus.NameToShort Then
  110.                 Full_list(a) = word
  111.              End If
  112.           
  113.           a = a + 1
  114.           DoEvents
  115.       End If
  116.   
  117.   Loop
  118.   Close #intFileNum
  119.  
  120.  SaveSetting App.EXEName, "Words", "Count", a
  121.  Full_list_count = a
  122.  
  123.   Unload Form1
  124.   
  125.   'MsgBox (Full_list(116))
  126.  
  127. End Sub
  128.  
  129.  
  130. Public Sub LoadMoreWords()
  131.  
  132. On Error Resume Next
  133.  
  134. Dim a As Long
  135. Dim ds As Long
  136. Dim awrds As Integer
  137. Dim last_awrds As Integer
  138. Dim word As String
  139. Dim meaning As String
  140. Dim intFileNum  As Long
  141. Dim strSpell As String
  142.  
  143. Form1.Show
  144. DoEvents
  145. ds = GetSetting(App.EXEName, "Words", "Count", "25000")
  146.  
  147. intFileNum = FreeFile
  148. Open App.Path & "\CustomWord.txt" For Input As #intFileNum
  149.  
  150.   Do While Not EOF(intFileNum)
  151.       Line Input #intFileNum, strSpell
  152.  
  153.       If Len(strSpell) > 0 Then
  154.           'If InStr(1, strSpell, ":") > 0 Then
  155.           '   word = Left$(strSpell, InStr(1, strSpell, ":") - 1)
  156.           '   meaning = Right$(strSpell, Len(strSpell) - InStr(1, strSpell, ":"))
  157.           'Else
  158.              word = strSpell
  159.             meaning = " N\A"
  160.          'End If
  161.                 
  162.        Select Case UCase(Left$(word, 1))
  163.               Case "A": awrds = 0
  164.               Case "B": awrds = 1
  165.               Case "C": awrds = 2
  166.               Case "D": awrds = 3
  167.               Case "E": awrds = 4
  168.               Case "F": awrds = 5
  169.               Case "G": awrds = 6
  170.               Case "H": awrds = 7
  171.               Case "I": awrds = 8
  172.               Case "J": awrds = 9
  173.               Case "K": awrds = 10
  174.               Case "L": awrds = 11
  175.               Case "M": awrds = 12
  176.               Case "N": awrds = 13
  177.               Case "O": awrds = 14
  178.               Case "P": awrds = 15
  179.               Case "Q": awrds = 16
  180.               Case "R": awrds = 17
  181.               Case "S": awrds = 18
  182.               Case "T": awrds = 19
  183.               Case "U": awrds = 20
  184.               Case "V": awrds = 21
  185.               Case "W": awrds = 22
  186.               Case "X": awrds = 23
  187.               Case "Y": awrds = 24
  188.               Case "Z": awrds = 25
  189.               Case Else: awrds = 26
  190.         End Select
  191.     
  192.             If Not awrds = last_awrds Then
  193.                 Form1.Label1.Caption = "Loading" & "... " & UCase(Left$(word, 1))
  194.                 last_awrds = awrds
  195.             End If
  196.     
  197.              alphabetWords(awrds).Add word, meaning
  198.              
  199.              If Not alphabetWords(awrds).Status = estrStatus.NameExists Or _
  200.                         Not alphabetWords(awrds).Status = estrStatus.NameToShort Then
  201.                 Full_list(a) = word
  202.              End If
  203.           
  204.           a = a + 1
  205.           DoEvents
  206.       End If
  207.   
  208.   Loop
  209.   Close #intFileNum
  210.  
  211.  SaveSetting App.EXEName, "Words", "Count", a
  212.  Full_list_count = a
  213.  
  214.   Unload Form1
  215.   
  216.   'MsgBox (Full_list(116))
  217.  
  218. End Sub
  219.  
  220.  
  221. Public Sub addWord(word)
  222.  
  223. strSpell = word
  224. If Len(strSpell) > 0 Then
  225.           'If InStr(1, strSpell, ":") > 0 Then
  226.           '   word = Left$(strSpell, InStr(1, strSpell, ":") - 1)
  227.           '   meaning = Right$(strSpell, Len(strSpell) - InStr(1, strSpell, ":"))
  228.           'Else
  229.              word = strSpell
  230.             meaning = " N\A"
  231.          'End If
  232.          
  233.         Dim tmpword As String
  234.         tmpword = word
  235.         exists = alphabetWords(awrds).Exist(tmpword)
  236.         If Not exists Then
  237.             Open App.Path & "\CustomWord.txt" For Append As #1
  238.                 Print #1, word
  239.             Close #1
  240.         End If
  241.                 
  242.        Select Case UCase(Left$(word, 1))
  243.               Case "A": awrds = 0
  244.               Case "B": awrds = 1
  245.               Case "C": awrds = 2
  246.               Case "D": awrds = 3
  247.               Case "E": awrds = 4
  248.               Case "F": awrds = 5
  249.               Case "G": awrds = 6
  250.               Case "H": awrds = 7
  251.               Case "I": awrds = 8
  252.               Case "J": awrds = 9
  253.               Case "K": awrds = 10
  254.               Case "L": awrds = 11
  255.               Case "M": awrds = 12
  256.               Case "N": awrds = 13
  257.               Case "O": awrds = 14
  258.               Case "P": awrds = 15
  259.               Case "Q": awrds = 16
  260.               Case "R": awrds = 17
  261.               Case "S": awrds = 18
  262.               Case "T": awrds = 19
  263.               Case "U": awrds = 20
  264.               Case "V": awrds = 21
  265.               Case "W": awrds = 22
  266.               Case "X": awrds = 23
  267.               Case "Y": awrds = 24
  268.               Case "Z": awrds = 25
  269.               Case Else: awrds = 26
  270.         End Select
  271.     
  272.         alphabetWords(awrds).Add word, meaning
  273.         a = a + 1
  274.         DoEvents
  275.         
  276.       End If
  277. End Sub
  278.  
  279.  
  280.