Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Spell Check for Source Code Strings/Comments

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Spell Check for Source Code Strings/Comments

    In the new version of gbSnippets I provide the capability of performing spell
    check on strings and comments that are found throughout an application's
    source code. Here's the source code showing how it works.

    The example below provides a RichEdit control which performs syntax highlighting
    on PowerBASIC source code. Additional functions are added
    to load the dictionary files (mainwords.txt and customwords.txt), display
    the spell check dialog, search for the word, ignore words, and display suggestions for mis-spelled
    words.

    This version uses a linear search lookup of the dictionary words, and
    seems to run plenty fast. I'll post an update later that uses a speedier
    binary search algorithm

    Features include:
    - string/comments only
    - recommends suggested spelling for words not in the dictionary
    - allows use to add words to a custom library file

    The code is provided below, and is also available in the
    gbSnippets PowerBASIC source code library (snippet# gbs_00395).
    You can get the entire library by downloading gbSnippets or you
    can view individual snippets online.

    gbSnippets home page: http://www.garybeene.com/sw/gbsnippets.htm
    Online source code listings: http://www.garybeene.com/power/code/

    If you've already installed gbSnippets, you can ensure that your local
    library is synchronized with the latest snippets on the gbSnippets server
    by using the "Actions/Synchronize with gbSnippets Server" menu.

    Finally, here's a direct link to the gbsnippets.pbr resource file use in this code:
    http://www.garybeene.com/files/gbsnippets.pbr

    Code:
    Spell Check (Source Code Strings/Comments)
    
    '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.
    
    '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.
    
    #Compile Exe
    #Dim All
    #Include "Win32api.inc"
    #Include "commctrl.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 String) As 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.txt" For 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 = "REM" Then  '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 Long) As 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, wParam, lParam)
    End Function
    
    Sub synApplySyntax()
      MousePTR 11                   'Scan all lines
      TurnOffCol(hDlg)
      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 Long) As 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(ByVal hDlg As Long)
    ' Set all text to black - faster this way
      Local cf As CHARFORMAT, xEvent As Long
      Local tTime As Single : tTime = Timer                      'get time
      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 = "REM" Then  '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
    Last edited by Gary Beene; 16 Oct 2009, 03:47 PM.
Working...
X