Spell Check (Source Code Strings/Comments)

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'The PowerBASIC compiler will check the spelling of code, but what about strings
'and comments?  Programmers often want to check that spelling as well but the IDE
'doesn't provide the capabilities.
 
'Using a variation on the syntax highlighting code (see snippet http://gbl_00281)
'and some additional functions for loading/searching dictionary files, this snippet
'can check the spelling of strings and comments, allowing the user to change
'incorrect spellings.
 
'This code also supports using two libraries - a main and custom library. Users
'can add words to the custom library.
 
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add this line:
#Include "CommCtrl.inc"
 
'Primary Code:
'Because of size, the primary code is shown only once, as part of the compilable example below.
'Here's how the pieces play together.
 
'1. On startup, LoadDictionaries reads and merges the standard word list and the custom word list.
'2. During execution of the app, the user selects "Perform SpellCheck", which calls ScanComments
'3. ScanComments parses the text, sequentially finding each string or comment. Each string/comment
'   it finds is passed to SendWordsToSpellChecker. The string/comment may contain multiple words.
'4. SendWordsToSpellChecker walks through each individual word in the string/comment, checking
'   to see if it is in the dictionary. If not, it passes the word and a list of suggested spellings to
'   a new dialog using DisplaySpellCheckDialog for user action.
'5. The user decides what to do - replace, ignore, ignore all, add, or close.  Add will add the
'    word to the custom dictionary file. Ignore all applies only until the current spell check
'    session completes.
'6. When the last word in the string/comment has been acted on, the dialog closes
'    and the spell check is over.
 
'Several word lists are supplied, containing 10K, 20K and 30K words - the most common such
'words according to WikiDictionary.  A custom word list is also supplied, in this case corresponding
'to custom words found in all of the gbSnippets PowerBASIC source code library.
 
'In this version, a simple linear search of the dictionary array is made - 10K words. For larger
'dictionaries, especially those in the 100K word size, a binary search would be a better choice.
'I'll post a binary search solution shortly.
 
'Compilable Example:
'For simplicity, this example uses only a very small list of keywords for syntax highlighting.
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc
#Include "RichEdit.inc"
 
%IDC_RichEdit = 500
Global LWords() As String, UWords() As String, MWords() As String, WordList() As String
Global StopSpellCheck&, IgnoreList() As String, NextWord$, SpellX&, SpellY&
Global hRichEdit As DWord, hDlg As DWord, OrigRichEditProc&, CodeCase&, hSpell As DWord
 
Function PBMain() As Long
   'create some sample content for the RichEdit control
   Dim Content$, i As Long
   Content$ = "Function Example()" + $CrLf + "   Select Case MyVar" + $CrLf + "      Case 12 'My cat Mouser"
   Content$ = Content$ + $Crlf + "      Case " + $DQ + "That dog" + $DQ + $CrLf + "   End Select"
   Content$ = Content$ + $CrLf + "   For i = 1 to 10" + $CrLf + "      Incr i" + $CrLf + "   Next i"
   Content$ = Content$ + $CrLf + "   If x = 2 Then" + $CrLf + "      'Your cow" + $CrLf + "   End If"
   Content$ = Content$ + $Crlf + "End Function"
   Dialog New Pixels, 0, "Spell Check Comments & Strings",300,300,400,400, %WS_OverlappedWindow To hDlg
   'create RichEdit and subclass (to intercept %WM_KeyUp actions)
   LoadLibrary("riched32.dll")
   InitCommonControls
   Control Add Option, hDlg, 201, "Upper", 10, 10, 50, 20
   Control Add Option, hDlg, 202, "Lower", 90, 10, 50, 20
   Control Add Option, hDlg, 203, "Mixed", 170, 10, 50, 20
   Control Add Button, hDlg, 204, "Perform Spellcheck", 10, 35, 200, 20
   Control Add Label, hDlg, 206,  "Dictionary(s)", 260,45,75,20
 
   Control Add ListBox, hDlg, 600, , 260, 65, 75, 260
   LoadDictionaries
   For i = 0 to UBound(WordList)
      If Len(WordList(i)) Then ListBox Add hDlg, 600, WordList(i)
   Next i
   Control Add "RichEdit", hDlg, %IDC_RichEdit, Content$, 10, 65, 240, 250, _
      %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, _
      %WS_Ex_ClientEdge
   Control Handle hDlg, %IDC_RichEdit To hRichEdit
   SetFont
   OrigRichEditProc& = SetWindowLong(GetDlgItem(hDlg, %IDC_RichEdit), %GWL_WndProc, CodePTR(TextWndProc))
   SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local temp$
   Select Case CB.Msg
      Case %WM_InitDialog
         CodeCase& = 1        'upper lower mixed
         Control Set Option hDlg, 201, 201, 203
         synInitializeRWords
         synApplySyntax
      Case %WM_Size
         '            Dim w As Long, h As Long
         '            Dialog Get Client CB.Hndl To w,h
         '            Control Set Size CB.Hndl, %IDC_RichEdit, w-20, h-70
      Case %WM_Command
         Select Case CB.Ctl
            Case 201 : CodeCase& = 1 : synApplySyntax
            Case 202 : CodeCase& = 2 : synApplySyntax
            Case 203 : CodeCase& = 3 : synApplySyntax
            Case 204
               StopSpellCheck& = 0
               ScanComments(SendMessage(hRichEdit, %EM_EXLineFromChar, 0, -1), SendMessage(hRichEdit, %EM_GETLINECOUNT, 0, 0) - 1)
               '                   ScanComments(0, SendMessage(hRichEdit, %EM_GETLINECOUNT, 0, 0) - 1)
               '                   MsgBox "Spell Check complete!"
               ReDim IgnoreList(0)          'get rid of all ignore list items, ready for next spell check
         End Select
   End Select
End Function
 
Sub SendWordsToSpellChecker
   'For this example, words in the selected text will be parsed - the highlighting
   'removed, then each word that was in the selected sequentially highlighted
   Local temp$, P As CharRange, tempZ As AsciiZ*200, suggestions$, iPos&
 
   'get start/end pos of selected text
   SendMessage hRichEdit, %EM_ExGetSel, 0,VarPTR(P)
   iPos& = P.cpmin
 
   'get selected text
   SendMessage hRichEdit, %EM_GetSelText,  0, VarPTR(tempZ)
 
   'unselect all so highlighting is visible in Sub
   P.cpmin = -1 : P.cpmax = 0
   SendMessage hRichEdit, %EM_EXSetSel, 0, VarPTR(P)
 
   temp$ = LCase$(tempZ)    'convert to lower case dynamic string (dictionary is lower case)
 
   Do While Len(temp$)
      NextWord$ = Extract$ (temp$, Any Chr$(0 To 47, 58 To 64, 91 To 96, 123 To 128) )
 
      'select the NextWord and pause to show that it is highlighted
      P.cpmin = iPos& : P.cpmax = iPos& + Len(NextWord)
      SendMessage hRichEdit, %EM_EXSetSel,  0, VarPTR(P)
 
      If Len(NextWord$) Then
         suggestions$ = GetSuggestedSpelling(NextWord$)     're-use temp$ to receive spelling recommendations
         If Len(suggestions$) AND NotInIgnoreList(NextWord$) Then
            '             If Len(suggestions$) Then
            'not found
            DisplaySpellCheckDialog suggestions$
            If StopSpellCheck& Then Exit Sub
            'MsgBox "Search word not found:  " + NextWord$ + $crlf + $crlf + "Suggestions:" + $crlf + $crlf + temp$
         Else
            'found - do nothing - go to next word
         End If
      End If
 
      'unselect all in preparation for highlighting of the next NextWord
      P.cpmin = -1 : P.cpmax = 0
      SendMessage hRichEdit, %EM_EXSetSel, 0, VarPTR(P)
 
      'continues
      iPos& = iPos& + Len(NextWord$) + 1                                'starting position of the next NextWord
      temp$ = Remain$( temp$, Any Chr$(0 To 47, 58 To 64, 91 To 96, 123 To 128) )  'remove current word and leading delimiter
   Loop
End Sub
 
Function NotInIgnoreList(sWord$) As Long
   Local i As Long
   If UBound(IgnoreList) < 1 Then
      Function = 1
      Exit Function
   End If
   For i = 1 to UBound(IgnoreList)
      If sWord$ = IgnoreList(i) Then
         Function = 0
         Exit Function
      End If
   Next i
   Function = 1
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$, foundFlag&
   searchword = Trim$(searchword)
 
   'simple linear search through array. resulting iPos& used to get suggestions.
   For iPos& = 0 to UBound(WordList)
      If searchword = WordList(iPos&) Then
         Exit Function       'Function stays at ""  (means word is found)
      ElseIf searchword < WordList(iPos&) Then
         Exit For       'All remaining array values do not match
      End If
   Next iPos
 
   If foundFlag& = 0 AND (iPos& < (UBound(WordList)+1))  Then
      'iPos contains the position the searchword "should" have been in
      'suggestions will be that position + 2 words in either direction (5 total)
      Lower = iPos&-2 : If Lower < 0 Then Lower = 0
      Upper = iPos&+2 : If Upper > UBound(WordList) Then Upper = UBound(WordList)
      For j = Lower to Upper : list$ = list$ + WordList(j) + $crlf : Next j
      Function = Trim$(list$, $crlf)
   End If
 
End Function
 
Sub DisplaySpellCheckDialog (list$)
   Local x As Long, y As Long, w As Long, h As Long, wX As Long, wY As Long
   Dialog Get Client hDlg To w,h
   wX = 300 : wY = 200
   x = (w-wX)/2    'gets left position of SpellDialog to center over app
   y = (h-wY)/2    'gets top position of SpellDialog to center over app
   If SpellX& = 0 AND SpellY& = 0 Then
      Dialog New Pixels, hDlg, "Spell Check", w+10, y, wX, wY, %WS_OverlappedWindow Or %WS_ClipChildren To hSpell
   Else
      Dialog New Pixels, hDlg, "Spell Check", SpellX&, SpellY&, wX, wY, %WS_OverlappedWindow Or %WS_ClipChildren To hSpell
   End If
 
   Control Add Label, hSpell, 1111, "Not Found", 10,10,80,20
   Control Add Label, hSpell, 1112, "Replace With", 10,30,80,20
 
   Control Add TextBox, hSpell, 2111, NextWord$, 100,10,190,20
   Control Add TextBox, hSpell, 2112, Extract$(list$,$crlf), 100,30,190,20
 
   Control Add Button, hSpell, 3112, "Replace", 10,60,50,20
   Control Add Button, hSpell, 3114, "Ignore", 70,60,40,20
   Control Add Button, hSpell, 3116, "Ignore All", 120,60,60,20
   Control Add Button, hSpell, 3115, "Add", 190,60,40,20
   Control Add Button, hSpell, 3113, "Close", 240,60,40,20
 
   Control Add Label, hSpell, 1113, "Suggestions", 10,90,80,20
   Dim S(ParseCount(list$,$crlf)) As String
   Parse list$, S(), $crlf
   Control Add ListBox, hSpell, 1114, S(), 10,110,280,90
 
   Dialog Show Modal hSpell Call SpellProc
End Sub
 
CallBack Function SpellProc()
   Local temp$, i As Long
   Select Case CB.Msg
      Case %WM_SysCommand
         If (CB.wParam AND &HFFF0) = %SC_Close Then          'trap Alt-F4 and X Button
            StopSpellCheck& = 1
         End If
      Case %WM_Destroy
         Dialog Get Loc hSpell TO SpellX&, SpellY&
      Case %WM_Command
         Select Case CB.Ctl
            Case 3112   'replace
               Control Get Text hSpell, 2112 To temp$
               SendMessage hRichEdit, %EM_ReplaceSel, %True, StrPTR(temp$)
               NextWord$ = temp$
               Dialog End hSpell
            Case 3113    'close
               StopSpellCheck& = 1
               Dialog End hSpell
            Case 3114    'ignore
               Dialog End hSpell
            Case 3116    'ignore all (add ignorelist)
               Control Get Text hSpell, 2111 To temp$
               ReDim Preserve IgnoreList(UBound(IgnoreList$())+1)
               IgnoreList(UBound(IgnoreList)) = temp$
               Dialog End hSpell
            Case 3115    'add
               Control Get Text hSpell, 2111 To temp$
               Open "customwords.txtFor Append as #1 : Print #1, temp$ : Close #1
               'rebuild dictionary array and put on main form
               ListBox Reset hDlg, 600
               LoadDictionaries
               For i = 0 to UBound(WordList)
                  If Len(WordList(i)) Then ListBox Add hDlg, 600, WordList(i)
               Next i
               Dialog End hSpell
            Case 600
               If CB.Ctlmsg = %LBN_SelChange Then
                  ListBox Get Text hSpell, 1114 To temp$
                  Control Set Text hSpell, 2112, temp$
               End If
         End Select
   End Select
End Function
 
Sub ScanComments(ByVal Line1 As Long, ByVal Line2 As Long)
   ' scans received line numbers for strings and comments, then sends those for action
   Local pd As CHARRANGE, tBuff As TEXTRANGE, xWord As String, Buf As String
   Local Aspect As Long, I As Long , J As Long, stopPos As Long
   Local lnLen As Long, wFlag As Byte, Letter As Byte Ptr
 
   For J = Line1 To Line2
      Aspect = SendMessage(hRichEdit, %EM_LINEINDEX, J, 0)       'line start
      lnLen  = SendMessage(hRichEdit, %EM_LINELENGTH, Aspect, 0) 'line length
 
      If lnLen Then
         Buf = Space$(lnLen + 1)
         tBuff.chrg.cpMin = Aspect
         tBuff.chrg.cpMax = Aspect + lnLen
         tBuff.lpstrText = StrPTR(Buf)
         lnLen = SendMessage(hRichEdit, %EM_GETTEXTRANGE, 0, ByVal VarPTR(tBuff)) 'Get line
 
         CharUpperBuff(ByVal StrPTR(Buf), lnLen)        'Make UCASE
 
         Letter = StrPTR(Buf) : wFlag = 0
         For I = 1 To Len(Buf)
            Select Case @Letter 'The characters we need to inlude in a word
               Case 97 To 122, 65 To 90, 192 To 214, 216 To 246, 248 To 255, _
                     35 To 38, 48 To 57, 63, 95
                  If wFlag = 0 Then
                     wFlag = 1 : stopPos = I
                  End If
 
               Case 34 ' string quotes -> "
                  stopPos = Instr(I + 1, Buf, Chr$(34)) 'Find match
                  If stopPos Then
                     pd.cpMin = Aspect + I
                     pd.cpMax = Aspect + stopPos - 1
                     SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                     SendWordsToSpellChecker
                     If StopSpellCheck& Then Exit Sub
                     '                   setRichTextColor &HFF                                             'string quotes found!!!!!!!!!!!
                     StopPos = (StopPos - I + 1)
                     I = I + StopPos
                     Letter = Letter + StopPos
                     wFlag = 0
                  End If
 
               Case 39 ' uncomment character -> '
                  pd.cpMin = Aspect + I - 1
                  pd.cpMax = Aspect + lnLen
                  SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                  SendWordsToSpellchecker
                  If StopSpellCheck& Then Exit Sub
                  '                 setRichTextColor &H00008000&                                      'comment strings found !!!!!!!!!!!!!!!!
                  wFlag = 0
                  Exit For
 
               Case Else  'word is ready (check for REM commets)
                  If wFlag = 1 Then
                     xWord = Mid$(Buf, stopPos, I - stopPos)  'Get word
                     If xWord = "REMThen  'extra for the uncomment word, REM
                        pd.cpMin = Aspect + I - Len(xWord) - 1
                        pd.cpMax = Aspect + lnLen
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                        SendWordsToSpellChecker
                        If StopSpellCheck& Then Exit Sub
                        '                       setRichTextColor &H00008000&                                'comment string found !!!!!!!!!!!!!!!!!!!!
                        wFlag = 0
                        Exit For
                     End If
                     wFlag = 0
                  End If
            End Select
 
            Incr Letter
         Next I
      End If
   Next J
 
End Sub
 
Function TextWndProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Select Case wMsg
      Case %WM_KeyUp         'trap key up, for syntax color check while editing
         Local CurLine As Long
         CurLine = SendMessage(hRichEdit, %EM_EXLINEFROMCHAR, 0, -1)
         ScanLine(CurLine, CurLine)               'check current line only
         Function = 0 : Exit Function                  'return zero
   End Select
   TextWndProc = CallWindowProc(OrigRichEditProc&, hWnd, wMsg, wParamlParam)
End Function
 
Sub synApplySyntax()
   MousePTR 11                   'Scan all lines
   TurnOffCol
   ScanLine(0, SendMessage(hRichEdit, %EM_GETLINECOUNT, 0, 0) - 1)
   MousePTR 0
   SetFocus hRichEdit
End Sub
 
Sub synInitializeRWords
   Data End,Function,Select,If,Then,For,Next,Case
   '... see the .Reference section for a complete set of PowerBASIC keywords to place here.
   Dim UWords(Datacount-1), LWords(Datacount - 1), MWords(Datacount-1), i As Long
   For i = 0 To Datacount - 1
      MWords(i) = Read$(i+1)
      UWords(i) = UCase$(MWords(i))
      LWords(i) = LCase$(MWords(i))
   Next i
End Sub
 
Function setRichTextColor( ByVal NewColor As LongAs Long
   ' setRichTextColor sets the textcolor for selected text in a Richedit control.
   ' &HFF - read, &HFF0000 - blue, &H008000 - dark green, &H0 is black, etc.
   Local cf As CHARFORMAT
   cf.cbSize      = Len(cf)       'Length of structure
   cf.dwMask      = %CFM_COLOR    'Set mask to colors only
   cf.crTextColor = NewColor      'Set the new color value
   SendMessage(hRichEdit, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPTR(cf))
End Function
 
Sub TurnOffCol
   ' Set all text to black - faster this way
   Local cf As CHARFORMAT, xEvent As Long
   xEvent = SendMessage(hRichEdit, %EM_GETEVENTMASK, 0, 0)         'Get eventmask
   '  SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, 0)            'Disable eventmask
   MousePTR 11                                                'Hourglass
   cf.cbSize      = Len(cf)                                   'Length of structure
   cf.dwMask      = %CFM_COLOR                                'Set mask to colors only
   cf.crTextColor = &H0                                       'Set black color value
   SendMessage(hRichEdit, %EM_SETCHARFORMAT, -1, VarPTR(cf)) '%SCF_ALL = -1
   If xEvent Then
      SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvent)     'Enable eventmask
   End If                                                     'Arrow
   MousePTR 0
   SendMessage(hRichEdit, %EM_SETMODIFY, %FALSE, 0)          'reset modify flag
End Sub
 
Sub ScanLine(ByVal Line1 As Long, ByVal Line2 As Long)
   ' Syntax color parser for received line numbers
   Local pd As CHARRANGE, Oldpd As CHARRANGE, tBuff As TEXTRANGE
   Local xWord As String, Buf As String
   Local Aspect As Long, xEvents As Long, I As Long , J As Long, stopPos As Long
   Local lnLen As Long, Result As Long, wFlag As Byte, Letter As Byte Ptr
 
   SendMessage(hRichEdit, %EM_EXGETSEL, 0, VarPTR(Oldpd)) 'Original position
   '(so we can reset it later)
   'Disable the event mask, for better speed
   xEvents = SendMessage(hRichEdit, %EM_GETEVENTMASK, 0, 0)
   SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, 0)
 
   'Turn off redraw for faster and smoother action
   SendMessage(hRichEdit, %WM_SETREDRAW, 0, 0)
 
   If Line1 <> Line2 Then                                  'if multiple lines
      MousePTR 11
   Else                                                                     'editing a line
      pd.cpMin = SendMessage(hRichEdit, %EM_LINEINDEX, Line1, 0)                'line start
      pd.cpMax = pd.cpMin + SendMessage(hRichEdit, %EM_LINELENGTH, pd.cpMin, 0) 'line end
      SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))                  'select line
      setRichTextColor &H0                                             'set black
   End If
 
   For J = Line1 To Line2
      Aspect = SendMessage(hRichEdit, %EM_LINEINDEX, J, 0)       'line start
      lnLen  = SendMessage(hRichEdit, %EM_LINELENGTH, Aspect, 0) 'line length
 
      If lnLen Then
         Buf = Space$(lnLen + 1)
         tBuff.chrg.cpMin = Aspect
         tBuff.chrg.cpMax = Aspect + lnLen
         tBuff.lpstrText = StrPTR(Buf)
         lnLen = SendMessage(hRichEdit, %EM_GETTEXTRANGE, 0, ByVal VarPTR(tBuff)) 'Get line
 
         CharUpperBuff(ByVal StrPTR(Buf), lnLen)        'Make UCASE
         'I always use this one, since it handles characters > ASC(127) as well.. ;-)
 
         '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         ' Loop through the line, using a pointer for better speed
         '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         Letter = StrPTR(Buf) : wFlag = 0
         For I = 1 To Len(Buf)
            Select Case @Letter 'The characters we need to inlude in a word
               Case 97 To 122, 65 To 90, 192 To 214, 216 To 246, 248 To 255, _
                     35 To 38, 48 To 57, 63, 95
                  If wFlag = 0 Then
                     wFlag = 1 : stopPos = I
                  End If
 
               Case 34 ' string quotes -> "
                  stopPos = Instr(I + 1, Buf, Chr$(34)) 'Find match
                  If stopPos Then
                     pd.cpMin = Aspect + I
                     pd.cpMax = Aspect + stopPos - 1
                     SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                     setRichTextColor &HFF
                     StopPos = (StopPos - I + 1)
                     I = I + StopPos
                     Letter = Letter + StopPos
                     wFlag = 0
                  End If
 
               Case 39 ' uncomment character -> '
                  pd.cpMin = Aspect + I - 1
                  pd.cpMax = Aspect + lnLen
                  SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                  setRichTextColor &H00008000&
                  wFlag = 0
                  Exit For
 
               Case Else  'word is ready
                  If wFlag = 1 Then
                     xWord = Mid$(Buf, stopPos, I - stopPos)  'Get word
 
                     If xWord = "REMThen  'extra for the uncomment word, REM
                        pd.cpMin = Aspect + I - Len(xWord) - 1
                        pd.cpMax = Aspect + lnLen
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                        setRichTextColor &H00008000&
                        wFlag = 0
                        Exit For
                     End If
                     Array Scan UWords(0), = xWord, To Result  'Is it in the array?
                     If Result Then
                        pd.cpMin = Aspect + stopPos - 1
                        pd.cpMax = Aspect + I - 1
                        '---------------------------------upper/lower/mixed handled here-----------
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                        If CodeCase& Then
                           xWord = Choose$(CodeCase&, UWords(Result-1), LWords(Result-1), MWords(Result-1))
                           Control Send hDlg, %IDC_RichEdit, %EM_ReplaceSel, %True, StrPTR(xWord)
                        End If
                        '----------------------------------------------------------------------
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                        setRichTextColor(&HFF0000)       'set blue color
                     End If
                     wFlag = 0
                  End If
            End Select
 
            Incr Letter
         Next I
      End If
   Next J
 
   'Reset original caret position
   SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(Oldpd))
 
   'Turn on Redraw again and refresh - this one causes some flicker in Richedit..
   SendMessage hRichEdit, %WM_SETREDRAW, 1, 0
   InvalidateRect hRichEdit, ByVal %NULL, 0 : UpdateWindow hRichEdit
 
   'Reset the event mask
   If xEvents Then SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvents)
End Sub
 
Sub SetFont
   Dim hFont As DWord
   Font New "Comic Sans MS", 10, 1 To hFont
   Control Set Font hDlg, %IDC_RichEdit, hFont
End Sub
 
Sub LoadDictionaries
   'loads two lists - main list and custom list. makes all words lowercase
   Dim listA$, listB$
   listA$ = "mainwords.txt"   :   listB$ = "customwords.txt"
   'get words from mainwords.txt
   If IsFile(listA$) Then
      Open listA$ For Binary As #1 : Get$ #1, Lof(1), listA$ : Close #1
   Else
      listA$ = "my" + $crlf + "dog" + $crlf + "is"
   End If
   'get words from customwords.txt
   If IsFile(listB$) Then
      Open listB$ For Binary As #1 : Get$ #1, Lof(1), listB$ : Close #1
   Else
      listB$ = "not" + $crlf + "your" + $crlf + "cat"
   End If
   'merge the two lists
   listA$ = listA$ + $crlf + listB$
   listA$ = LCase$(listA$)     'ensure everything is lower case
 
   'convert the combined strings into array WordList() which is a Global array
   ReDim WordList(ParseCount(listA$,$crlf))
   Parse listA$, WordList(), $crlf
   Array Sort WordList()
End Sub
 
'gbs_00395
'Date: 03-10-2012


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