[456] | 1 | unit uSpell;
|
---|
| 2 |
|
---|
| 3 | {$O-}
|
---|
| 4 |
|
---|
| 5 | interface
|
---|
| 6 |
|
---|
| 7 | uses
|
---|
| 8 | Windows, Messages, SysUtils, Classes, Controls, Forms, ComObj, StdCtrls, ComCtrls,
|
---|
| 9 | ORSystem, Word2000, ORFn, Variants, rCore, clipbrd;
|
---|
| 10 |
|
---|
| 11 | type
|
---|
| 12 |
|
---|
| 13 | TSpellCheckAvailable = record
|
---|
| 14 | Evaluated: boolean;
|
---|
| 15 | Available: boolean;
|
---|
| 16 | end;
|
---|
| 17 |
|
---|
| 18 | function SpellCheckAvailable: Boolean;
|
---|
| 19 | function SpellCheckInProgress: Boolean;
|
---|
| 20 | procedure KillSpellCheck;
|
---|
| 21 | procedure SpellCheckForControl(AnEditControl: TCustomMemo);
|
---|
| 22 | procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
|
---|
| 23 |
|
---|
| 24 | implementation
|
---|
| 25 |
|
---|
| 26 | const
|
---|
| 27 | TX_WINDOW_TITLE = 'CPRS-Chart Spell Checking #';
|
---|
| 28 | TX_NO_SPELL_CHECK = 'Spell checking is unavailable.';
|
---|
| 29 | TX_NO_GRAMMAR_CHECK = 'Grammar checking is unavailable.';
|
---|
| 30 | TX_SPELL_COMPLETE = 'The spelling check is complete.';
|
---|
| 31 | TX_GRAMMAR_COMPLETE = 'The grammar check is complete.';
|
---|
| 32 | TX_SPELL_ABORT = 'The spelling check terminated abnormally.';
|
---|
| 33 | TX_GRAMMAR_ABORT = 'The grammar check terminated abnormally.';
|
---|
| 34 | TX_SPELL_CANCELLED = 'Spelling check was cancelled before completion.';
|
---|
| 35 | TX_GRAMMAR_CANCELLED = 'Grammar check was cancelled before completion.';
|
---|
| 36 | TX_NO_DETAILS = 'No further details are available.';
|
---|
| 37 | TX_NO_CORRECTIONS = 'Corrections have NOT been applied.';
|
---|
| 38 | CR_LF = #13#10;
|
---|
| 39 | SPELL_CHECK = 'S';
|
---|
| 40 | GRAMMAR_CHECK = 'G';
|
---|
| 41 |
|
---|
| 42 | var
|
---|
| 43 | WindowList: TList;
|
---|
| 44 | OldList, NewList: TList;
|
---|
| 45 | MSWord: OleVariant;
|
---|
| 46 | uSpellCheckAvailable: TSpellCheckAvailable;
|
---|
| 47 |
|
---|
| 48 | function SpellCheckInProgress: boolean;
|
---|
| 49 | begin
|
---|
| 50 | Result := not VarIsEmpty(MSWord);
|
---|
| 51 | end;
|
---|
| 52 |
|
---|
| 53 | procedure KillSpellCheck;
|
---|
| 54 | begin
|
---|
| 55 | if SpellCheckInProgress then
|
---|
| 56 | begin
|
---|
| 57 | MSWord.Quit(wdDoNotSaveChanges);
|
---|
| 58 | VarClear(MSWord);
|
---|
| 59 | end;
|
---|
| 60 | end;
|
---|
| 61 |
|
---|
| 62 | function SpellCheckTitle: string;
|
---|
| 63 | begin
|
---|
| 64 | Result := TX_WINDOW_TITLE + IntToStr(Application.Handle);
|
---|
| 65 | end;
|
---|
| 66 |
|
---|
| 67 | function GetWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;
|
---|
| 68 | begin
|
---|
| 69 | Result := True;
|
---|
| 70 | WindowList.Add(Pointer(Handle));
|
---|
| 71 | end;
|
---|
| 72 |
|
---|
| 73 | procedure GetWindowList(List: TList);
|
---|
| 74 | begin
|
---|
| 75 | WindowList := List;
|
---|
| 76 | EnumWindows(@GetWindows, 0);
|
---|
| 77 | end;
|
---|
| 78 |
|
---|
| 79 | procedure BringWordToFront(OldList, NewList: TList);
|
---|
| 80 | var
|
---|
| 81 | i, NameLen: integer;
|
---|
| 82 | WinName: array[0..160] of char;
|
---|
| 83 | NewWinName: PChar;
|
---|
| 84 | NewName: string;
|
---|
| 85 |
|
---|
| 86 | begin
|
---|
| 87 | NewName := SpellCheckTitle;
|
---|
| 88 | NameLen := length(NewName);
|
---|
| 89 | for i := 0 to NewList.Count-1 do
|
---|
| 90 | begin
|
---|
| 91 | if(OldList.IndexOf(NewList[i]) < 0) then
|
---|
| 92 | begin
|
---|
| 93 | GetWindowText(HWND(NewList[i]), WinName, sizeof(WinName) - 1);
|
---|
| 94 | if Pos('CPRS', WinName) > 0 then
|
---|
| 95 | NewWinName := PChar(Copy(WinName, Pos('CPRS', WinName), sizeof(WinName) - 1))
|
---|
| 96 | else
|
---|
| 97 | NewWinName := WinName;
|
---|
| 98 | if StrLComp(NewWinName, pchar(NewName), NameLen)=0 then
|
---|
| 99 | begin
|
---|
| 100 | Application.ProcessMessages;
|
---|
| 101 | SetForegroundWindow(HWND(NewList[i]));
|
---|
| 102 | break;
|
---|
| 103 | end;
|
---|
| 104 | end;
|
---|
| 105 | end;
|
---|
| 106 | end;
|
---|
| 107 |
|
---|
| 108 | { Spell Checking using Visual Basic for Applications script }
|
---|
| 109 |
|
---|
| 110 | function SpellCheckAvailable: Boolean;
|
---|
| 111 | //const
|
---|
| 112 | // WORD_VBA_CLSID = 'CLSID\{000209FF-0000-0000-C000-000000000046}';
|
---|
| 113 | begin
|
---|
| 114 | // CHANGED FOR PT. SAFETY ISSUE RELEASE 19.16, PATCH OR*3*155 - ADDED NEXT 2 LINES:
|
---|
| 115 | //result := false;
|
---|
| 116 | //exit;
|
---|
| 117 | // Reenabled in version 21.1, via parameter setting (RV)
|
---|
| 118 | // Result := (GetUserParam('ORWOR SPELL CHECK ENABLED?') = '1');
|
---|
| 119 | with uSpellCheckAvailable do // only want to call this once per session!!! v23.10+
|
---|
| 120 | begin
|
---|
| 121 | if not Evaluated then
|
---|
| 122 | begin
|
---|
| 123 | Available := (GetUserParam('ORWOR SPELL CHECK ENABLED?') = '1');
|
---|
| 124 | Evaluated := True;
|
---|
| 125 | end;
|
---|
| 126 | Result := Available;
|
---|
| 127 | end;
|
---|
| 128 | end;
|
---|
| 129 |
|
---|
| 130 | procedure SpellAndGrammarCheckForControl(var AnotherEditControl: TCustomMemo; ACheck: Char);
|
---|
| 131 | var
|
---|
| 132 | NoLFText, LFText: string;
|
---|
| 133 | OneChar: char;
|
---|
| 134 | ErrMsg: string;
|
---|
| 135 | FinishedChecking: boolean;
|
---|
| 136 | OldSaveInterval, i: integer;
|
---|
| 137 | MsgText: string;
|
---|
| 138 | FirstLineBlank: boolean;
|
---|
| 139 | OldLine0: string;
|
---|
| 140 | begin
|
---|
| 141 | if AnotherEditControl = nil then Exit;
|
---|
| 142 | OldList := TList.Create;
|
---|
| 143 | NewList := TList.Create;
|
---|
| 144 | FinishedChecking := False;
|
---|
| 145 | FirstLineBlank := False;
|
---|
| 146 | NoLFText := '';
|
---|
| 147 | OldLine0 := '';
|
---|
| 148 | ClipBoard.Clear;
|
---|
| 149 | try
|
---|
| 150 | try
|
---|
| 151 | GetWindowList(OldList);
|
---|
| 152 | try
|
---|
| 153 | Screen.Cursor := crHourGlass;
|
---|
| 154 | MSWord := CreateOLEObject('Word.Application');
|
---|
| 155 | except // MSWord not available, so exit now
|
---|
| 156 | Screen.Cursor := crDefault;
|
---|
| 157 | case ACheck of
|
---|
| 158 | SPELL_CHECK : MsgText := TX_NO_SPELL_CHECK;
|
---|
| 159 | GRAMMAR_CHECK: MsgText := TX_NO_GRAMMAR_CHECK;
|
---|
| 160 | else MsgText := ''
|
---|
| 161 | end;
|
---|
| 162 | Application.MessageBox(PChar(MsgText), PChar(Application.Title), MB_ICONWARNING);
|
---|
| 163 | Exit;
|
---|
| 164 | end;
|
---|
| 165 |
|
---|
| 166 | GetWindowList(NewList);
|
---|
| 167 | try
|
---|
| 168 | MSWord.Application.Caption := SpellCheckTitle;
|
---|
| 169 | // Position Word off screen to avoid having document visible...
|
---|
| 170 | MSWord.WindowState := 0;
|
---|
| 171 | MSWord.Top := -3000;
|
---|
| 172 | OldSaveInterval := MSWord.Application.Options.SaveInterval;
|
---|
| 173 | MSWord.Application.Options.SaveInterval := 0;
|
---|
| 174 | MSWord.Application.Options.AutoFormatReplaceQuotes := False;
|
---|
| 175 | MSWord.Application.Options.AutoFormatAsYouTypeReplaceQuotes := False;
|
---|
| 176 | MSWord.ResetIgnoreAll;
|
---|
| 177 |
|
---|
| 178 | MSWord.Documents.Add; // FileNew
|
---|
| 179 | MSWord.ActiveDocument.TrackRevisions := False;
|
---|
| 180 | with AnotherEditControl do
|
---|
| 181 | if (Lines.Count > 0) and (not ContainsVisibleChar(Lines[0])) then
|
---|
| 182 | begin
|
---|
| 183 | FirstLineBlank := True; //MS bug when spell-checking document with blank first line (RV - v22.6)
|
---|
| 184 | OldLine0 := Lines[0];
|
---|
| 185 | Lines.Delete(0);
|
---|
| 186 | end;
|
---|
| 187 | MSWord.ActiveDocument.Content.Text := (AnotherEditControl.Text); // The Text property returns the plain, unformatted text of the selection or range.
|
---|
| 188 | // When you set this property, the text of the range or selection is replaced.
|
---|
| 189 | BringWordToFront(OldList, NewList);
|
---|
| 190 | MSWord.ActiveDocument.Content.SpellingChecked := False;
|
---|
| 191 | MSWord.ActiveDocument.Content.GrammarChecked := False;
|
---|
| 192 |
|
---|
| 193 | case ACheck of
|
---|
| 194 | SPELL_CHECK : begin
|
---|
| 195 | MSWord.ActiveDocument.Content.CheckSpelling; // ToolsSpelling
|
---|
| 196 | FinishedChecking := MSWord.ActiveDocument.Content.SpellingChecked;
|
---|
| 197 | end;
|
---|
| 198 | GRAMMAR_CHECK: begin
|
---|
| 199 | MSWord.ActiveDocument.Content.CheckGrammar; // ToolsGrammar
|
---|
| 200 | FinishedChecking := MSWord.ActiveDocument.Content.GrammarChecked;
|
---|
| 201 | end;
|
---|
| 202 | end;
|
---|
| 203 | if FinishedChecking then // not cancelled?
|
---|
| 204 | NoLFText := MSWord.ActiveDocument.Content.Text // EditSelectAll
|
---|
| 205 | else
|
---|
| 206 | NoLFText := '';
|
---|
| 207 | finally
|
---|
| 208 | Screen.Cursor := crDefault;
|
---|
| 209 | MSWord.Application.Options.SaveInterval := OldSaveInterval;
|
---|
| 210 | case ACheck of
|
---|
| 211 | SPELL_CHECK : FinishedChecking := MSWord.ActiveDocument.Content.SpellingChecked;
|
---|
| 212 | GRAMMAR_CHECK: FinishedChecking := MSWord.ActiveDocument.Content.GrammarChecked;
|
---|
| 213 | end;
|
---|
| 214 | MSWord.Quit(wdDoNotSaveChanges);
|
---|
| 215 | VarClear(MSWord);
|
---|
| 216 | end;
|
---|
| 217 | finally
|
---|
| 218 | OldList.Free;
|
---|
| 219 | NewList.Free;
|
---|
| 220 | end;
|
---|
| 221 | except
|
---|
| 222 | on E: Exception do
|
---|
| 223 | begin
|
---|
| 224 | ErrMsg := E.Message;
|
---|
| 225 | FinishedChecking := False;
|
---|
| 226 | end;
|
---|
| 227 | end;
|
---|
| 228 |
|
---|
| 229 | Screen.Cursor := crDefault;
|
---|
| 230 | Application.BringToFront;
|
---|
| 231 | if FinishedChecking then
|
---|
| 232 | begin
|
---|
| 233 | if (Length(NoLFText) > 0) then
|
---|
| 234 | begin
|
---|
| 235 | LFText := '';
|
---|
| 236 | for i := 1 to Length(NoLFText) do
|
---|
| 237 | begin
|
---|
| 238 | OneChar := NoLFText[i];
|
---|
| 239 | LFText := LFText + OneChar;
|
---|
| 240 | if OneChar = #13 then LFText := LFText + #10;
|
---|
| 241 | end;
|
---|
| 242 | with AnotherEditControl do if Lines.Count > 0 then
|
---|
| 243 | begin
|
---|
| 244 | Text := LFText;
|
---|
| 245 | if FirstLineBlank then Text := OldLine0 + Text;
|
---|
| 246 | end;
|
---|
| 247 | case ACheck of
|
---|
| 248 | SPELL_CHECK : MsgText := TX_SPELL_COMPLETE;
|
---|
| 249 | GRAMMAR_CHECK: MsgText := TX_GRAMMAR_COMPLETE;
|
---|
| 250 | else MsgText := ''
|
---|
| 251 | end;
|
---|
| 252 | Application.MessageBox(PChar(MsgText), PChar(Application.Title), MB_ICONINFORMATION);
|
---|
| 253 | end
|
---|
| 254 | else
|
---|
| 255 | begin
|
---|
| 256 | case ACheck of
|
---|
| 257 | SPELL_CHECK : MsgText := TX_SPELL_CANCELLED;
|
---|
| 258 | GRAMMAR_CHECK: MsgText := TX_GRAMMAR_CANCELLED;
|
---|
| 259 | else MsgText := ''
|
---|
| 260 | end;
|
---|
| 261 | Application.MessageBox(PChar(MsgText + CR_LF + CR_LF + TX_NO_CORRECTIONS), PChar(Application.Title), MB_ICONINFORMATION);
|
---|
| 262 | end;
|
---|
| 263 | end
|
---|
| 264 | else // error during spell or grammar check
|
---|
| 265 | begin
|
---|
| 266 | case ACheck of
|
---|
| 267 | SPELL_CHECK : MsgText := TX_SPELL_ABORT;
|
---|
| 268 | GRAMMAR_CHECK: MsgText := TX_GRAMMAR_ABORT;
|
---|
| 269 | else MsgText := ''
|
---|
| 270 | end;
|
---|
| 271 | if ErrMsg = '' then ErrMsg := TX_NO_DETAILS;
|
---|
| 272 | Application.MessageBox(PChar(MsgText + CR_LF + ErrMsg + CR_LF + CR_LF + TX_NO_CORRECTIONS), PChar(Application.Title), MB_ICONWARNING);
|
---|
| 273 | end;
|
---|
| 274 | SendMessage(TRichEdit(AnotherEditControl).Handle, WM_VSCROLL, SB_TOP, 0);
|
---|
| 275 | AnotherEditControl.SetFocus;
|
---|
| 276 | end;
|
---|
| 277 |
|
---|
| 278 | procedure SpellCheckForControl(AnEditControl: TCustomMemo);
|
---|
| 279 | begin
|
---|
| 280 | if AnEditControl = nil then Exit;
|
---|
| 281 | SpellAndGrammarCheckForControl(AnEditControl, SPELL_CHECK);
|
---|
| 282 | end;
|
---|
| 283 |
|
---|
| 284 | procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
|
---|
| 285 | begin
|
---|
| 286 | if AnEditControl = nil then Exit;
|
---|
| 287 | SpellAndGrammarCheckForControl(AnEditControl, GRAMMAR_CHECK);
|
---|
| 288 | end;
|
---|
| 289 |
|
---|
| 290 |
|
---|
| 291 | end.
|
---|