source: cprs/trunk/CPRS-Chart/uSpell.pas@ 468

Last change on this file since 468 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76
File size: 9.6 KB
Line 
1unit uSpell;
2
3{$O-}
4
5interface
6
7uses
8 Windows, Messages, SysUtils, Classes, Controls, Forms, ComObj, StdCtrls, ComCtrls,
9 ORSystem, Word2000, ORFn, Variants, rCore, clipbrd;
10
11type
12
13 TSpellCheckAvailable = record
14 Evaluated: boolean;
15 Available: boolean;
16 end;
17
18function SpellCheckAvailable: Boolean;
19function SpellCheckInProgress: Boolean;
20procedure KillSpellCheck;
21procedure SpellCheckForControl(AnEditControl: TCustomMemo);
22procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
23
24implementation
25
26const
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
42var
43 WindowList: TList;
44 OldList, NewList: TList;
45 MSWord: OleVariant;
46 uSpellCheckAvailable: TSpellCheckAvailable;
47
48function SpellCheckInProgress: boolean;
49begin
50 Result := not VarIsEmpty(MSWord);
51end;
52
53procedure KillSpellCheck;
54begin
55 if SpellCheckInProgress then
56 begin
57 MSWord.Quit(wdDoNotSaveChanges);
58 VarClear(MSWord);
59 end;
60end;
61
62function SpellCheckTitle: string;
63begin
64 Result := TX_WINDOW_TITLE + IntToStr(Application.Handle);
65end;
66
67function GetWindows(Handle: HWND; Info: Pointer): BOOL; stdcall;
68begin
69 Result := True;
70 WindowList.Add(Pointer(Handle));
71end;
72
73procedure GetWindowList(List: TList);
74begin
75 WindowList := List;
76 EnumWindows(@GetWindows, 0);
77end;
78
79procedure BringWordToFront(OldList, NewList: TList);
80var
81 i, NameLen: integer;
82 WinName: array[0..160] of char;
83 NewWinName: PChar;
84 NewName: string;
85
86begin
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;
106end;
107
108{ Spell Checking using Visual Basic for Applications script }
109
110function SpellCheckAvailable: Boolean;
111//const
112// WORD_VBA_CLSID = 'CLSID\{000209FF-0000-0000-C000-000000000046}';
113begin
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;
128end;
129
130procedure SpellAndGrammarCheckForControl(var AnotherEditControl: TCustomMemo; ACheck: Char);
131var
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;
140begin
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;
276end;
277
278procedure SpellCheckForControl(AnEditControl: TCustomMemo);
279begin
280 if AnEditControl = nil then Exit;
281 SpellAndGrammarCheckForControl(AnEditControl, SPELL_CHECK);
282end;
283
284procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
285begin
286 if AnEditControl = nil then Exit;
287 SpellAndGrammarCheckForControl(AnEditControl, GRAMMAR_CHECK);
288end;
289
290
291end.
Note: See TracBrowser for help on using the repository browser.