Spellchecking with Windows

[adeyblue]

Example of using the built-in spell checking stuff in Windows 8+
Requires the upto date headers & libs from https://www.freebasic.net/forum/viewtopic.php?t=32786

Code: Select all

/'
T:\nsdir is where the package in https://www.freebasic.net/forum/viewtopic.php?t=32786 in unpacked
fbc64 -O 2 spell.bas -p T:\nsdir\lib\x64 -l uuid -l ole32 -l kernel32
'/
#include once "T:\nsdir\globalization.bi"
#include once "T:\nsdir\system.com.bi"

IFaceWrapDef(ISpellCheckerFactory)
IFaceWrapDef(ISpellChecker)
IFaceWrapDef(ISpellingError)
IFaceWrapDef(IEnumSpellingError)
IFaceWrapDef(IEnumString)

Private Sub PrintStringList(ByVal indentSize as Long, ByVal spStrings As IEnumString Ptr, ByVal header As WString Ptr)

    dim as string paddingSpace = Space(indentSize)
    Print *header
    dim as long seenAny
    Do
        dim as PWSTR pString = Any
        dim as ULONG numGot = Any
        spStrings->__Next(1, @pString, @numGot)
        If numGot = 0 Then Exit Do
        seenAny += 1
        Print paddingSpace;
        Print *pString
        CoTaskMemFree(pString)
    Loop
    If seenAny = 0 Then
        Print paddingSpace;
        Print "None to show!"
    End If
End Sub

dim as ComInit com
dim as IFaceWrapName(ISpellCheckerFactory) spCheckFactory

CoCreateLocalISpellCheckerFactory(CLSID_SpellCheckerFactory, @spCheckFactory)

Const supportedHeader = WStr("Supported Dictionary Languages:")
Scope
    dim as IFaceWrapName(IEnumString) languages = (*spCheckFactory)->get_SupportedLanguages()
    PrintStringList(0, *languages, @supportedHeader)
    Print
End Scope

Print "Enter language, or blank entry to exit"

dim as wstring * 50 chosenLang

Do
    Line Input chosenLang
    If Len(chosenLang) > 0 Then
        If (*spCheckFactory)->IsSupported(@chosenLang) = __FALSE Then
            Print chosenLang & WStr(" not supported, please select a different language")
        Else
            Exit Do
        End If
    Else
        End
    End If
Loop

dim as IFaceWrapName(ISpellChecker) spCheck = (*spCheckFactory)->CreateSpellChecker(@chosenLang)

Print "Type a word and press enter. Blank entry exits the program"

Do
   dim as wstring * 50 typed
   Line Input typed
   dim as Long typedLen = Len(typed)
   If typedLen = 0 Then Exit Do
   dim as IFaceWrapName(IEnumSpellingError) spErrors = (*spCheck)->Check(@typed)
   dim as Long hadAnyErrors
   Do
      dim as IFaceWrapName(ISpellingError) spError = (*spErrors)->__Next()
      If *spError <> NULL Then
          hadAnyErrors += 1
          dim as ULONG startindex = (*spError)->get_StartIndex()
          dim as ULONG errLen = (*spError)->get_Length()
          dim as string caretIndent = IIf(startIndex > 0, Space(startIndex), "")
          dim as string errMark = Iif(errLen < 1, "", String(errLen, Asc("^")))
          dim as Long postPaddingLen = (typedLen - Len(caretIndent) - Len(errMark)) + 2
          Print caretIndent + errMark + Space(postPaddingLen);
          Select Case As Const (*spError)->get_CorrectiveAction()
              Case CORRECTIVE_ACTION_GET_SUGGESTIONS
                  dim as IFaceWrapName(IEnumString) suggestions = (*spCheck)->Suggest(@typed)
                  Const header = WStr("Suggestions: ")
                  PrintStringList(typedLen + 2, *suggestions, @header)
              Case CORRECTIVE_ACTION_REPLACE
                  dim as PWSTR pRepText = (*spError)->get_Replacement()
                  Print WStr(" Replace marked with ") & *pRepText
                  CoTaskMemFree(pRepText)
              Case CORRECTIVE_ACTION_DELETE
                  Print "??? Ain't got a clue bruv, delete this embarassment"
          End Select
          Print
      Else
          Exit Do
      End If
   Loop
   If hadAnyErrors = 0 Then Print "No errors found in this word!"
Loop

Sample output:

Code: Select all

Supported Dictionary Languages:
en-CA
en-LR
en-PH
en-US

Enter language, or blank entry to exit
en-US
Type a word and press enter. Blank entry exits the program
Mountebankery
^^^^^^^^^^^^^  Suggestions:
               None to show!

Quinquangle
^^^^^^^^^^^  Suggestions:
             Quinquangular

Obstrepperous
^^^^^^^^^^^^^  Suggestions:
               Obstreperous

Nomenclature
No errors found in this word!
Magcheesium
^^^^^^^^^^^  Suggestions:
             None to show!

This was Server 2019 so it might've gotten a bit better by Windows 11. Bit weird it knows quinquangular but not quinquangle and that it knows plenipotentiary and elemi (different test) but not mountebankery, has it never done a Times cryptic crossword?

The no-suggestions thing might need to use the 'Check harder stupid' function ((*spCheck)->ComprehensiveCheck(@typed)) that I didn't put in the example. I couldn't find any entry, even random rubbish like pzwfstwah that triggered either of the Replace or Delete responses, not that I tried for particularly long. It will give multiple suggestions if it has them, they just didn't show up in this session.