Tweet
After getting Spell check working Thesaurus was easy.
------------------
Code:
#PBFORMS Created
'--------------------------------------------------------------------------------
' The first line in this file is a PBForms metastatement.
' It should ALWAYS be the first line of the file. Other
' PBForms metastatements are placed at the beginning and
' ending of blocks of code that should be edited using
' PBForms only. Do not edit or delete these
' metastatements or PBForms will not be able to reread
' the file correctly. See the PBForms documentation for
' more information.
' Beginning blocks begin like this: #PBForms Begin ...
' Ending blocks begin like this: #PBForms End ...
' Other PBForms metastatements such as:
' #PBForms Declarations
' are used to tell PBForms where to insert additional
' code. Feel free to make changes anywhere else in the file.
'--------------------------------------------------------------------------------
'
'***************************Word dependent spell check***************************
'This will work with at least Word 97 & 2000.
'oword9.inc if you haven't done it yet is created by Com browser.
'Easy to select all interfaces and save to file.
'My Word.Application.9 will not work with .8. I have 97 and 2000.
'You should probably make *.inc for your version.
'App works with 3 PC's all running Win98SE. For some reason I have not discovered
'there is a bug that shows up in my fourth, wife's machine. Word does not always
'open first time for her. It does always open second try. No idea...tried every
'PB trick I could find. That includes everything you can see in OBJACTIVE Function
'Help plus links. If anyone has ideas I should like to hear from you.
#COMPILE EXE
#DIM ALL
#INCLUDE "oword9.inc"
'--------------------------------------------------------------------------------
' ** Includes **
'--------------------------------------------------------------------------------
#PBFORMS Begin Includes
#RESOURCE "SpellCheck.pbr"
#IF NOT %DEF(%WINAPI)
#INCLUDE "WIN32API.INC"
#ENDIF
#PBFORMS End Includes
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Constants **
'--------------------------------------------------------------------------------
#PBFORMS Begin Constants
%IDR_IMGFILE1 = 102
%IDD_SPELLCHECK = 101
%IDC_CHECKSPELLING = 1001
%IDC_QUIT = 1002
%IDC_LABEL1 = 1003
%IDC_SPELLCHECKBOX = 1004
%IDC_THESAURUS = 1005
#PBFORMS End Constants
$AppTitle = "Spell Check"
GLOBAL DialogWindow AS DWORD 'If you use PBForms this is an easy way to use handle.
GLOBAL SpellingFlag AS LONG
GLOBAL ThesaurusFlag AS LONG
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** Declarations **
'--------------------------------------------------------------------------------
DECLARE CALLBACK FUNCTION ShowSPELLCHECKProc()
DECLARE FUNCTION SampleListBox(BYVAL hDlg AS DWORD, BYVAL lID AS LONG, BYVAL _
lCount AS LONG) AS LONG
DECLARE FUNCTION ShowSPELLCHECK(BYVAL hParent AS DWORD) AS LONG
DECLARE SUB DisplayResult(msg AS STRING)
#PBFORMS Declarations
'--------------------------------------------------------------------------------
'Function provided by Lance. This function is more helpful than a bunch of numbers.
'***Highly recommended***
FUNCTION ObjErr(BYVAL pbError AS LONG, BYVAL dError AS DWORD) AS STRING
LOCAL pBuffer AS ASCIIZ PTR
LOCAL ncbBuffer AS DWORD
LOCAL a$
ncbBuffer = FormatMessage(%FORMAT_MESSAGE_ALLOCATE_BUFFER OR _
%FORMAT_MESSAGE_FROM_SYSTEM OR %FORMAT_MESSAGE_IGNORE_INSERTS, _
BYVAL %NULL, dError, BYVAL MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), _
BYVAL VARPTR(pBuffer), 0, BYVAL %NULL)
IF pbError THEN a$ = "(PB Error =" & STR$(pbError) & ")"
IF ncbBuffer THEN
a$ = " " & @pBuffer & " (&H" & HEX$(dError, 8) & ") " + a$
REPLACE $CRLF WITH "" IN a$
FUNCTION = a$
LocalFree pBuffer
ELSE
FUNCTION = " Unknown error (&H" & HEX$(dError, 8) & ") " + a$
END IF
END FUNCTION
FUNCTION CheckSpellingThesaurus(BYVAL hDlg AS DWORD) AS LONG
DIM oWordApp AS WordApplication 'Object or Dispatch variables
DIM oWordDocs AS WordDocuments
DIM oWordSel AS WordSelection
DIM oWordDiag AS WordDialog
DIM vVnt AS VARIANT 'Everything coming or going has to be Variant.
DIM vText AS VARIANT
DIM vBool AS VARIANT
DIM vDiag AS VARIANT
DIM vCorrect AS VARIANT
DIM lOrigTop AS VARIANT
LOCAL SpellWord AS STRING
LOCAL SpaceFind AS LONG
CONTROL GET TEXT DialogWindow, %IDC_SPELLCHECKBOX TO SpellWord
IF SpellWord = "" THEN EXIT FUNCTION
IF ISTRUE SpellingFlag THEN SpaceFind = INSTR(SpellWord, " ")
'Should check for all manner of illegal charactors here but I havn't yet
IF SpaceFind > 0 THEN
MSGBOX "Please enter only one word without spaces.", %MB_ICONINFORMATION, $AppTitle
EXIT FUNCTION
END IF
' Open an instance of MSWORD *Copy and paste from OWord.bas Lots of that here.
SET oWordApp = WordApplication IN "Word.Application"
IF ISFALSE ISOBJECT(oWordApp) THEN _
SET oWordApp = NEW WordApplication IN "Word.Application"
'Could MSWORD be opened? If not, terminate this app
IF ISFALSE ISOBJECT(oWordApp) THEN
MSGBOX "Unable to open Word." '***This is where my wifes machine ends up.***
EXIT FUNCTION
END IF
LET vVnt = 0
OBJECT CALL oWordApp.Documents.Add TO vVnt
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Documents.Add: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
SET oWordDocs = vVnt
OBJECT GET oWordApp.Selection TO vVnt
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Selection: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
SET oWordSel = vVnt
LET vText = SpellWord
OBJECT LET oWordSel.Text = vText 'Puts in and selects word to spell
IF ISTRUE ThesaurusFlag THEN LET vDiag = %wdDialogToolsThesaurus 'Got this from Microsoft.
IF ISTRUE SpellingFlag THEN LET vDiag = %wdDialogToolsSpellingAndGrammar
OBJECT CALL oWordApp.Dialogs.Item(vDiag) TO vVnt 'Gets interface to spell check/thesaurus dialog
IF OBJRESULT OR ERR THEN
MSGBOX "oWordDiag.Dialogs.Item(vDiag): " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
SET oWordDiag = vVnt
' Make MSWORD visible
LET vBool = 1
OBJECT LET oWordApp.Visible = vBool 'Make word visible so you can hide it.
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Visible = vBool: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
OBJECT GET oWordApp.Top TO lOrigTop 'This from Microsoft also
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Top TO lOrigTop: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
LET vVnt = 0
OBJECT LET oWordApp.WindowState = vVnt 'Ditto
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.WindowState = vVnt: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
LET vVnt= -3000 'And more from Bill
OBJECT LET oWordApp.Top = vVnt
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Top = vVnt: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
OBJECT CALL oWordDiag.Show TO vBool 'Makes visible %wdDialogToolsSpellingAndGrammar
IF OBJRESULT OR ERR THEN
MSGBOX "oWordDiag.Show: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
LET vVnt = 0
OBJECT LET oWordApp.Selection.Start = vVnt 'Puts at start and selects correctly spelled word
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Selection.Start: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
OBJECT GET oWordApp.Selection.Text TO vCorrect 'Get selected correctly spelled word
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Selection.Copy: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
'Dialog returns true if word is changed, false if no change.
IF ISTRUE VARIANT#(vBool) = -1 THEN CONTROL SET TEXT DialogWindow, %IDC_SPELLCHECKBOX, VARIANT$(vCorrect)
'
IF SpellWord = VARIANT$(vCorrect) AND ISTRUE VARIANT#(vBool) = -1 THEN _
CONTROL SET TEXT DialogWindow, %IDC_SPELLCHECKBOX, SpellWord + " ...is spelled correctly."
Terminate:
LET vVnt = %wdDoNotSaveChanges 'Another tidbit from Microsoft
OBJECT CALL oWordApp.Documents.Close(vVnt) 'Close without saving changes
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Documents.Close(vVnt): " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
LET vVnt= 0
OBJECT LET oWordApp.Top = vVnt 'My machine with Word 97 developed a profound desire to stay minimized without this.
IF OBJRESULT OR ERR THEN
MSGBOX "oWordApp.Top = vVnt: " & ObjErr(ERRCLEAR, OBJRESULT) & STR$(VARIANT#(vVnt)), %MB_ICONEXCLAMATION
EXIT FUNCTION
END IF
OBJECT CALL oWordApp.Quit 'Close Word.
' Close all of the Interfaces
SET oWordSel = NOTHING
SET oWordDocs = NOTHING
SET oWordApp = NOTHING
SET oWordDiag = NOTHING
FUNCTION = %TRUE
END FUNCTION
FUNCTION PBMAIN()
ShowSPELLCHECK %HWND_DESKTOP
FUNCTION = %TRUE
END FUNCTION
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
' ** CallBacks **
'--------------------------------------------------------------------------------
CALLBACK FUNCTION ShowSPELLCHECKProc()
LOCAL SetSelection AS LONG
LOCAL SpellCheck AS STRING
SELECT CASE CBMSG
CASE %WM_INITDIALOG 'Select opening string so you will not have to.
CONTROL SEND CBHNDL, %IDC_SPELLCHECKBOX, %EM_SETSEL, 0, 71
CONTROL SET FOCUS CBHNDL, %IDC_SPELLCHECKBOX
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE %IDC_CHECKSPELLING
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
SpellingFlag = %TRUE
CALL CheckSpellingThesaurus(CBHNDL)
SpellingFlag = %FALSE
END IF
CASE %IDC_THESAURUS
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
ThesaurusFlag = %TRUE
CALL CheckSpellingThesaurus(CBHNDL)
ThesaurusFlag = %FALSE
END IF
CASE %IDC_QUIT
IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
DIALOG END CBHNDL, 0
END IF
CASE %IDC_LABEL1
CASE %IDC_SPELLCHECKBOX
END SELECT
END SELECT
END FUNCTION
'--------------------------------------------------------------------------------
' ** Dialogs **
'--------------------------------------------------------------------------------
FUNCTION ShowSPELLCHECK(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
#PBFORMS Begin Dialog %IDD_SPELLCHECK->->
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Spell Check & Thesaurus", 206, 127, 302, 59, %WS_POPUP _
OR %WS_BORDER OR %WS_DLGFRAME OR %WS_CAPTION OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
%DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_WINDOWEDGE OR _
%WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET ICON hDlg, "#" + FORMAT$(%IDR_IMGFILE1)
CONTROL ADD BUTTON, hDlg, %IDC_CHECKSPELLING, "&Spelling", 5, 40, 50, 15, _
%WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_TEXT OR %BS_PUSHBUTTON _
OR %BS_DEFPUSHBUTTON OR %BS_CENTER OR %BS_VCENTER, %WS_EX_LEFT OR _
%WS_EX_LTRREADING
CONTROL ADD BUTTON, hDlg, %IDC_QUIT, "&Quit", 245, 40, 50, 15
CONTROL ADD LABEL, hDlg, %IDC_LABEL1, "Spelling && Thesaurus by Microsoft " + _
"Word", 85, 5, 135, 10
CONTROL ADD TEXTBOX, hDlg, %IDC_SPELLCHECKBOX, "Type word to check here...", _
5, 15, 290, 13, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_LEFT OR _
%ES_AUTOVSCROLL, %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR %WS_EX_LTRREADING _
OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD BUTTON, hDlg, %IDC_THESAURUS, "&Thesaurus", 60, 40, 50, 15
#PBFORMS End Dialog
DialogWindow = hDlg
DIALOG SHOW MODAL hDlg, CALL ShowSPELLCHECKProc TO lRslt
FUNCTION = lRslt
END FUNCTION