Spell Check (Using Word Object)

Category: Controls - RichEdit

Date: 02-16-2022

Return to Index


 
'Just about about everyone wants to do spell check on user input. One approach is
'to use the built-in capabilities of an application already installed on most user's
'machines - Microsoft Word.  This snippet shows how it's done.
 
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add this line:
#Include "CommCtrl.inc"
 
'Primary Code:
'Credit: Peter Redei
'Because of it's length, the primary procedure "Spell" is included only in the
'compilable example below.
Sub Spell ALIAS "Spell"(sWord AS String, sSuggs() AS StringEXPORT
  '...see the compilable example below
End Sub
 
'Compilable Example:  (Jose Includes)
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc
#Include "RichEdit.inc"
 
'#Include "includes\msword.inc"
Global hDlg as Dword, hRichEdit as Dword
%ID_RichEdit = 500
 
Function PBMain() As Long
   Local style&, buf$
   buf$ =  "This is sample" + $CrLf + "text for the" + $CrLf + "editt control."
   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,150, %WS_OverlappedWindow To hDlg
   Control Add Button, hDlg, 100,"Spell Check Selected Word", 10,10,180,20
   LoadLibrary("riched32.dll") : InitCommonControls
   Control Add "RichEdit", hDlg, %ID_RichEdit, buf$,20,40,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
   If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
      Local temp$, tempZ As AsciiZ*200
      ReDim sSuggs(0) AS String
 
      SendMessage hRichEdit, %EM_GetSelText,  0, VarPTR(tempZ)   'get selected text
      temp$ = tempZ
 
      Spell temp$, sSuggs()
      If UBound(sSuggs) = 0 Then
         MsgBox "The spelling seems to be correct"
      Else
         MsgBox Join$(sSuggs(), $CRLF), 0, "How about one of these?"
      End If
   End If
End Function
 
Sub Spell ALIAS "Spell"(sWord AS String, sSuggs() AS StringEXPORT
   Local oWordApp AS DISPATCH 'Int__Application,
   Local WordNotOpen As Long
   Dim dWordApp AS DISPATCH
   Dim oSpellingSuggestions AS DISPATCH    ' Spelling Suggestions collection
   Dim oSpellingSuggestion AS DISPATCH     ' Spelling Suggestion class
   Dim vBool       AS VARIANT
   Dim vVnt        AS VARIANT
   Dim vText       AS VARIANT
   Dim vRes        AS VARIANT
   Dim suggs       As Long
   Dim i           As Long
   'oWordApp = Int__Application IN "Word.Application"
   oWordApp = NEWCOM "Word.Application"
 
   'IF ISFALSE ISOBJECT(oWordApp) THEN
   '    SET oWordApp = NEW Int__Application IN "Word.Application"
   '    WordNotOpen=1  '%True
   'END IF
   ' Could MSWORD be opened? If not we will not check the spelling
   If IsTrue IsObject(oWordApp) Then
      dWordApp = oWordApp
      'add a document
      vVnt = 0
      Object Call oWordApp.Documents.Add
      'OBJECT CALL oWordApp.Documents.Add TO vVnt
      vText = sWord
      vRes = 0
      Object Call dWordApp.GetSpellingSuggestions(vText) TO vRes
      oSpellingSuggestions = vRes
      vBool = 0
      Object Get oSpellingSuggestions.Count TO vBool
      suggs = Variant#(vBool)
      If suggs > 0 Then
         ReDim sSuggs(1 TO suggs)
         For i = 1 TO suggs
            vVnt = i
            vRes = 0
            Object Call oSpellingSuggestions.Item(i) TO vRes
            oSpellingSuggestion = vRes
            vBool = 0
            Object Get oSpellingSuggestion.Name TO vBool
            sSuggs(i) = Variant$(vBool)
         Next
      End If
      vVnt = 0
      Object Call dWordApp.ActiveWindow.Close(vVnt)
      If WordNotOpen Then Object Call dWordApp.Quit
      oSpellingSuggestion = NOTHING
      oSpellingSuggestions = NOTHING
   End If
   oWordApp  = NOTHING
End Sub
'gbs_00394
'Date: 03-10-2012


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