source: cprs/branches/tmg-cprs/CPRS-Chart/uSpell.pas@ 1226

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

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