source: cprs/branches/foia-cprs/CPRS-Chart/uSpell.pas@ 459

Last change on this file since 459 was 459, checked in by Kevin Toppenberg, 17 years ago

Adding foia-cprs branch
File size: 9.5 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.ResetIgnoreAll;
176
177 MSWord.Documents.Add; // FileNew
178 MSWord.ActiveDocument.TrackRevisions := False;
179 with AnotherEditControl do
180 if (Lines.Count > 0) and (not ContainsVisibleChar(Lines[0])) then
181 begin
182 FirstLineBlank := True; //MS bug when spell-checking document with blank first line (RV - v22.6)
183 OldLine0 := Lines[0];
184 Lines.Delete(0);
185 end;
186 MSWord.ActiveDocument.Content.Text := (AnotherEditControl.Text); // The Text property returns the plain, unformatted text of the selection or range.
187 // When you set this property, the text of the range or selection is replaced.
188 BringWordToFront(OldList, NewList);
189 MSWord.ActiveDocument.Content.SpellingChecked := False;
190 MSWord.ActiveDocument.Content.GrammarChecked := False;
191
192 case ACheck of
193 SPELL_CHECK : begin
194 MSWord.ActiveDocument.Content.CheckSpelling; // ToolsSpelling
195 FinishedChecking := MSWord.ActiveDocument.Content.SpellingChecked;
196 end;
197 GRAMMAR_CHECK: begin
198 MSWord.ActiveDocument.Content.CheckGrammar; // ToolsGrammar
199 FinishedChecking := MSWord.ActiveDocument.Content.GrammarChecked;
200 end;
201 end;
202 if FinishedChecking then // not cancelled?
203 NoLFText := MSWord.ActiveDocument.Content.Text // EditSelectAll
204 else
205 NoLFText := '';
206 finally
207 Screen.Cursor := crDefault;
208 MSWord.Application.Options.SaveInterval := OldSaveInterval;
209 case ACheck of
210 SPELL_CHECK : FinishedChecking := MSWord.ActiveDocument.Content.SpellingChecked;
211 GRAMMAR_CHECK: FinishedChecking := MSWord.ActiveDocument.Content.GrammarChecked;
212 end;
213 MSWord.Quit(wdDoNotSaveChanges);
214 VarClear(MSWord);
215 end;
216 finally
217 OldList.Free;
218 NewList.Free;
219 end;
220 except
221 on E: Exception do
222 begin
223 ErrMsg := E.Message;
224 FinishedChecking := False;
225 end;
226 end;
227
228 Screen.Cursor := crDefault;
229 Application.BringToFront;
230 if FinishedChecking then
231 begin
232 if (Length(NoLFText) > 0) then
233 begin
234 LFText := '';
235 for i := 1 to Length(NoLFText) do
236 begin
237 OneChar := NoLFText[i];
238 LFText := LFText + OneChar;
239 if OneChar = #13 then LFText := LFText + #10;
240 end;
241 with AnotherEditControl do if Lines.Count > 0 then
242 begin
243 Text := LFText;
244 if FirstLineBlank then Text := OldLine0 + Text;
245 end;
246 case ACheck of
247 SPELL_CHECK : MsgText := TX_SPELL_COMPLETE;
248 GRAMMAR_CHECK: MsgText := TX_GRAMMAR_COMPLETE;
249 else MsgText := ''
250 end;
251 Application.MessageBox(PChar(MsgText), PChar(Application.Title), MB_ICONINFORMATION);
252 end
253 else
254 begin
255 case ACheck of
256 SPELL_CHECK : MsgText := TX_SPELL_CANCELLED;
257 GRAMMAR_CHECK: MsgText := TX_GRAMMAR_CANCELLED;
258 else MsgText := ''
259 end;
260 Application.MessageBox(PChar(MsgText + CR_LF + CR_LF + TX_NO_CORRECTIONS), PChar(Application.Title), MB_ICONINFORMATION);
261 end;
262 end
263 else // error during spell or grammar check
264 begin
265 case ACheck of
266 SPELL_CHECK : MsgText := TX_SPELL_ABORT;
267 GRAMMAR_CHECK: MsgText := TX_GRAMMAR_ABORT;
268 else MsgText := ''
269 end;
270 if ErrMsg = '' then ErrMsg := TX_NO_DETAILS;
271 Application.MessageBox(PChar(MsgText + CR_LF + ErrMsg + CR_LF + CR_LF + TX_NO_CORRECTIONS), PChar(Application.Title), MB_ICONWARNING);
272 end;
273 SendMessage(TRichEdit(AnotherEditControl).Handle, WM_VSCROLL, SB_TOP, 0);
274 AnotherEditControl.SetFocus;
275end;
276
277procedure SpellCheckForControl(AnEditControl: TCustomMemo);
278begin
279 if AnEditControl = nil then Exit;
280 SpellAndGrammarCheckForControl(AnEditControl, SPELL_CHECK);
281end;
282
283procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
284begin
285 if AnEditControl = nil then Exit;
286 SpellAndGrammarCheckForControl(AnEditControl, GRAMMAR_CHECK);
287end;
288
289
290end.
Note: See TracBrowser for help on using the repository browser.