Spell Check (Single Word)

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'Just about about everyone wants to do spell check on user input. In the case of an incorrectly
'spelled word, it's also common to suggest spellings from which a user might choose.
 
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add this line:
#Include "CommCtrl.inc"
 
'Primary Code:
 
 
'Compilable Example:
'I'm especially interested in spell check on the text strings within source code. This code
'shows one way to do it - based on having a text file of alphabetized, correctly spelled words.
 
'In this case, the text file is simply loaded into a string array and a binary search is used
'to determine if the word is in the dictionary.  If the word is not found, this approach show
'words +/- 4 positions from where the word might be in the list.  There are several other
'suggestion algorithms.
 
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc
#Include "RichEdit.inc"
 
Global hDlg as Dword, hRichEdit as Dword, W() as String
'W() is Global array containing the word list (lower case letters)
%ID_RichEdit = 500
 
Function PBMain() As Long
   Local style&, buf$
   buf$ =  "My oven is hot" + $CrLf + "but the zoo is not."
   style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
   Dialog New Pixels, 0, "Test Code",300,300,200,220, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Search For Selected Word", 20,20,160,20
   Control Add Button, hDlg, 200,"Search Entire RichEdit Control", 20,50,160,20
   LoadLibrary("riched32.dll") : InitCommonControls
   Control Add "RichEdit", hDlg, %ID_RichEdit, buf$,20,80,160,100, style&, %WS_EX_ClientEdge
   Control Handle hDlg, %ID_RichEdit To hRichEdit
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Select Case CB.Msg
      Case %WM_InitDialog
         LoadWordList
      Case %WM_Command
         If CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
            Local temp$, tempZ as AsciiZ * 4096
            SendMessage(hRichEdit, %EM_GetSelText, 0, VarPTR(tempZ))          'get text, selected
            If Len(tempZ) Then
               temp$ = Trim$(tempZ)                     'remaining functions work with dynamic string
               temp$ = GetSuggestedSpelling(temp$)     're-use temp$ to receive spelling recommendations
               If Len(temp$) Then
                  'not found
                  MsgBox "Search word not found:  " + tempZ + $crlf + $crlf + "Suggestions:" + $crlf + $crlf + temp$
               Else
                  'found
                  MsgBox "Spelling is correct!"
               End If
            Else
               MsgBox "No search term selected!"
            End If
         End If
   End Select
End Function
 
Function GetSuggestedSpelling(searchword As StringAs String
   'returns "" if spelling is correct, otherwise returns list of suggested words separated by $crlf
   Local iPos&, j as Long, Upper As Long, Lower As Long, list$
   iPos& = WordNotFound(searchword)
   If iPos& Then
      Lower = iPos&-2 : If Lower < 0 Then Lower = 0
      Upper = iPos&+2 : If Upper > UBound(W) Then Upper = UBound(W)
      For j = Lower to Upper : list$ = list$ + W(j) + $crlf : Next j
      Function = Trim$(list$, $crlf)
   End If
End Function
 
Function WordNotFound(searchword As StringAs Long
   'returns 0 if found, otherwise returns position of word in array where it "should" have been
   'simple top to bottom of array search. array must be sorted (ascending top to bottom)
   'Other sesarch options:   Array Scan statement, Binary Search
   Local Upper As Long, Lower As Long, i As Long
   searchword = Trim$(searchword)
   For i = 0 to UBound(W)
      If searchword = W(i) Then
         Exit For       'Function stays at zero  (means word is found)
      ElseIf searchword < W(i) Then
         Function = i
         Exit For       'All remaining array values do not match
      End If
   Next i
End Function
 
Sub LoadWordList
   'loads two lists - main list and custom list. makes all words lowercase
   Dim listA$, listB$
   listA$ = "wordlist.txt"   :   listB$ = "customwords.txt"
   'get words from wordlist.txt
   If IsFile(listA$) Then
      Open listA$ For Binary As #1 : Get$ #1, Lof(1), listA$ : Close #1
   End If
   'get words from wordlist.txt
   If IsFile(listB$) Then
      Open listB$ For Binary As #1 : Get$ #1, Lof(1), listB$ : Close #1
   End If
 
   'merge the two lists
   If Len(listA$) = 0 Then
      listA$ = listB$
   Else
      If Len(listA$) Then
         listA$ = listA$ + $crlf + listB$
      End If
   End If
   listA$ = LCase$(listA$)     'ensure everything is lower case
 
   'convert the combined strings into array W() which is a Global array
   ReDim W(ParseCount(listA$,$crlf))
   Parse listA$, W(), $crlf
   Array Sort W()
End Sub
 
'gbs_00340
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm