Changeset 1705 for cprs/branches/HealthSevak-CPRS/CPRS-Chart
- Timestamp:
- May 9, 2015, 7:42:17 AM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
cprs/branches/HealthSevak-CPRS/CPRS-Chart/uSpell.pas
r841 r1705 1 1 unit uSpell; 2 2 // Word settings need to be restored to origional settings! 3 3 {$O-} 4 5 {$DEFINE CPRS} 6 {$UNDEF CPRS} 4 7 5 8 interface … … 7 10 uses 8 11 Windows, Messages, SysUtils, Classes, Controls, Forms, ComObj, StdCtrls, ComCtrls, 9 ORSystem, Word2000, ORFn, Variants, rCore, clipbrd;12 rCore, ORFn, Word2000, Office_TLB, Variants, clipbrd, ActiveX, Contnrs, PSAPI, ExtCtrls; 10 13 11 14 type 12 13 15 TSpellCheckAvailable = record 14 16 Evaluated: boolean; … … 16 18 end; 17 19 18 function SpellCheckAvailable: Boolean;19 20 function SpellCheckInProgress: Boolean; 20 21 procedure KillSpellCheck; 21 procedure SpellCheckForControl(AnEditControl: TCustomMemo); 22 function SpellCheckAvailable: Boolean; 23 procedure SpellCheckForControl(AnEditControl: TCustomMemo; OpenSource: Boolean = False); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine ; added 2nd parameter} 22 24 procedure GrammarCheckForControl(AnEditControl: TCustomMemo); 23 25 24 implementation 26 // Do Not Call these routines - internal use only 27 procedure InternalSpellCheck(SpellCheck: boolean; EditControl: TCustomMemo); 28 procedure RefocusSpellCheckWindow; 25 29 26 30 const 27 TX_WINDOW_TITLE = 'CPRS-Chart Spell Checking #'; 31 SpellCheckerSettingName = 'SpellCheckerSettings'; 32 //ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine ; 33 {moved following from implementation section to this place to make them visible outside unit too} 28 34 TX_NO_SPELL_CHECK = 'Spell checking is unavailable.'; 29 35 TX_NO_GRAMMAR_CHECK = 'Grammar checking is unavailable.'; … … 34 40 TX_SPELL_CANCELLED = 'Spelling check was cancelled before completion.'; 35 41 TX_GRAMMAR_CANCELLED = 'Grammar check was cancelled before completion.'; 42 43 TX_NO_CORRECTIONS = 'Corrections have NOT been applied.'; 44 TX_NO_DETAILS = 'No further details are available.'; 45 CRLF = #13#10; 46 47 var 48 SpellCheckerSettings: string = ''; 49 50 51 implementation 52 53 uses VAUtils, fSpellNotify, uInit, fHunSpell; 54 55 const 56 TX_ERROR_TITLE = 'Error'; 57 TX_ERROR_INTRO = 'An error has occured.'; 58 TX_TRY_AGAIN = 'Would you like to try again?'; 59 TX_WINDOW_TITLE = 'CPRS-Chart Spell Checking #'; 60 { TX_NO_SPELL_CHECK = 'Spell checking is unavailable.'; 61 {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine ;} 62 {moved following from implementation section to this place to make them visible outside unit too} 63 //begin comment @ska 64 { TX_NO_GRAMMAR_CHECK = 'Grammar checking is unavailable.'; 65 TX_SPELL_COMPLETE = 'The spelling check is complete.'; 66 TX_GRAMMAR_COMPLETE = 'The grammar check is complete.'; 67 TX_SPELL_ABORT = 'The spelling check terminated abnormally.'; 68 TX_GRAMMAR_ABORT = 'The grammar check terminated abnormally.'; 69 TX_SPELL_CANCELLED = 'Spelling check was cancelled before completion.'; 70 TX_GRAMMAR_CANCELLED = 'Grammar check was cancelled before completion.'; 36 71 TX_NO_DETAILS = 'No further details are available.'; 37 72 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 73 CRLF = #13#10;} 74 //end comment @ska 75 76 // TABOO_STARTING_CHARS = '!"#$%&()*+,./:;<=>?@[\]^_`{|}'; 77 VALID_STARTING_CHARS = '''-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; 78 79 type 80 TMSWordThread = class(TThread) 81 private 82 FBeforeLines: TStringList; 83 FAfterLines: TStringList; 84 FWordSettings: TList; 85 FWordVersion: single;{To support Office 2010 & above ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine ; added new variable;} 86 FEditControl: TCustomMemo; 87 FShowingMessage: boolean; 88 // FEmptyVar: OleVariant; 89 FFalseVar: OleVariant; 90 // FTrueVar: OleVariant; 91 FNullStr: OleVariant; 92 FWord: WordApplication; 93 FDoc: WordDocument; 94 FDialog: OleVariant; 95 FDocDlg: OleVariant; 96 FText: string; 97 FSpellCheck: boolean; 98 FSucceeded: boolean; 99 FCanceled: boolean; 100 FTitle: string; 101 FDocWindowHandle: HWnd; 102 FOldFormChange: TNotifyEvent; 103 FOldOnActivate: TNotifyEvent; 104 FError: Exception; 105 FErrorText1: string; 106 FErrorText2: string; 107 FAllowErrorRetry: boolean; 108 FRetryResult: TShow508MessageResult; 109 FResultMessage: string; 110 FSpellChecking: boolean; 111 FLock: TRTLCriticalSection; 112 procedure OnFormChange(Sender: TObject); 113 procedure OnAppActivate(Sender: TObject); 114 procedure OnThreadTerminate(Sender: TObject); 115 procedure FindDocumentWindow; 116 procedure TransferText; 117 function RunWithErrorTrap(AMethod: TThreadMethod; 118 SpellCheckErrorMessage, GrammarCheckErrorMessage, AdditionalErrorMessage: string; 119 AllowRetry: boolean): boolean; 120 procedure WordError; 121 procedure StartWord; 122 procedure CreateDocument; 123 procedure DoCheck; 124 procedure ConfigWord; 125 procedure ConfigDoc; 126 procedure GetDialogs; 127 procedure SaveUserSettings; 128 procedure LoadUserSettings; 129 procedure ExitWord; 130 procedure ReportResults; 131 procedure SaveWordSettings; 132 procedure RestoreWordSettings; 133 function UserSetting(Index: integer): boolean; 134 procedure ThreadLock; 135 procedure ThreadUnlock; 136 protected 137 constructor CreateThread(SpellCheck: boolean; AEditControl: TCustomMemo); 138 procedure Execute; override; 139 public 140 procedure RefocusSpellCheckDialog; 141 property Text: string read FText; 142 property Succeeded: boolean read FSucceeded; 143 property Canceled: boolean read FCanceled; 144 end; 145 146 var 147 MSWordThread: TMSWordThread = nil; 148 149 function ControlHasText(SpellCheck: boolean; AnEditControl: TCustomMemo): boolean; 150 var 151 i: integer; 152 begin 153 Result := FALSE; 154 if not assigned(AnEditControl) then 155 ShowMsg('Spell Check programming error') 156 else 157 begin 158 for i := 0 to AnEditControl.Lines.Count - 1 do 56 159 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 160 if trim(AnEditControl.Lines[i]) <> '' then 99 161 begin 100 Application.ProcessMessages; 101 SetForegroundWindow(HWND(NewList[i])); 162 Result := TRUE; 102 163 break; 103 164 end; 104 165 end; 105 end; 106 end; 166 if not Result then 167 begin 168 if SpellCheck then 169 ShowMsg(TX_SPELL_COMPLETE) 170 else 171 ShowMsg(TX_GRAMMAR_COMPLETE) 172 end; 173 end; 174 end; 175 176 function SpellCheckInProgress: boolean; 177 begin 178 Result := assigned(MSWordThread); 179 end; 180 181 var 182 uSpellCheckAvailable: TSpellCheckAvailable; 183 184 procedure KillSpellCheck; 185 var 186 checking: boolean; 187 WordHandle: HWnd; 188 ProcessID: DWORD; 189 ProcessHandle: THandle; 190 191 begin 192 if assigned(MSWordThread) then 193 begin 194 with MSWordThread do 195 begin 196 ThreadLock; 197 try 198 checking := FSpellChecking; 199 WordHandle := FDocWindowHandle; 200 Terminate; 201 finally 202 ThreadUnlock; 203 end; 204 try 205 if checking then 206 begin 207 GetWindowThreadProcessId(WordHandle, ProcessID); 208 ProcessHandle := OpenProcess(PROCESS_TERMINATE, False, ProcessID); 209 try 210 TerminateProcess(ProcessHandle, 0); 211 finally 212 CloseHandle(ProcessHandle); 213 end; 214 end; 215 if assigned(MSWordThread) then 216 begin 217 WaitFor; 218 end; 219 except 220 end; 221 end; 222 end; 223 end; 224 107 225 108 226 { Spell Checking using Visual Basic for Applications script } … … 128 246 end; 129 247 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; 248 {//ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine, added new proc} 249 procedure DoHanSpellCheck(anEditControl: TCustomMemo); 250 //Initiates OpenSource (HunSpell) based Spell check 251 begin 252 SuspendTimeout; 149 253 try 254 {being a class function, we don't have to create an object instance beforehand} 255 TfrmHunSpell.DoHunSpellCheck(AnEditControl); 256 finally 257 ResumeTimeout; 258 end; 259 end; 260 261 procedure DoSpellCheck(SpellCheck: boolean; AnEditControl: TCustomMemo; OpenSource: Boolean = False); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Added second parameter} 262 var 263 frmSpellNotify: TfrmSpellNotify; 264 begin 265 {//ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; commented out net line} 266 //if assigned(MSWordThread) then exit; {commented out this line and instead added additional check for OpenSource in next line} 267 if (assigned(MSWordThread) and not OpenSource) then exit; 268 269 if ControlHasText(SpellCheck, AnEditControl) then 270 {//ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine} 271 //Begin @ska ; added next three new lines 272 if OpenSource and SpellCheck then 273 DoHanSpellCheck(AnEditControl) 274 else 275 //end @ska; 01 May 2015 276 begin 277 frmSpellNotify := TfrmSpellNotify.Create(Application); 150 278 try 151 GetWindowList(OldList);279 SuspendTimeout; 152 280 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 := ''; 281 frmSpellNotify.SpellCheck := SpellCheck; 282 frmSpellNotify.EditControl := AnEditControl; 283 frmSpellNotify.ShowModal; 207 284 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); 285 ResumeTimeout; 216 286 end; 217 287 finally 218 OldList.Free; 219 NewList.Free; 220 end; 221 except 222 on E: Exception do 288 frmSpellNotify.Free; 289 end; 290 end; 291 end; 292 293 procedure InternalSpellCheck(SpellCheck: boolean; EditControl: TCustomMemo); 294 begin 295 MSWordThread := TMSWordThread.CreateThread(SpellCheck, EditControl); 296 while assigned(MSWordThread) do 297 begin 298 Application.ProcessMessages; 299 sleep(50); 300 end; 301 end; 302 303 procedure RefocusSpellCheckWindow; 304 begin 305 if assigned(MSWordThread) then 306 MSWordThread.RefocusSpellCheckDialog; 307 end; 308 309 procedure SpellCheckForControl(AnEditControl: TCustomMemo; OpenSource: Boolean = False); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; added second parameter} 310 begin 311 DoSpellCheck(True, AnEditControl, OpenSource); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; added second parameter} 312 end; 313 314 procedure GrammarCheckForControl(AnEditControl: TCustomMemo); 315 begin 316 DoSpellCheck(False, AnEditControl); 317 end; 318 { TMSWordThread } 319 320 const 321 RETRY_MAX = 3; 322 323 usCheckSpellingAsYouType = 1; 324 usCheckGrammarAsYouType = 2; 325 usIgnoreInternetAndFileAddresses = 3; 326 usIgnoreMixedDigits = 4; 327 usIgnoreUppercase = 5; 328 usCheckGrammarWithSpelling = 6; 329 usShowReadabilityStatistics = 7; 330 usSuggestFromMainDictionaryOnly = 8; 331 usSuggestSpellingCorrections = 9; 332 usHideSpellingErrors = 10; 333 usHideGrammarErrors = 11; 334 335 sTrueCode = 'T'; 336 sFalseCode = 'F'; 337 338 // AFAYT = AutoFormatAsYouType 339 wsAFAYTApplyBorders = 0; 340 wsAFAYTApplyBulletedLists = 1; 341 wsAFAYTApplyFirstIndents = 2; 342 wsAFAYTApplyHeadings = 3; 343 wsAFAYTApplyNumberedLists = 4; 344 wsAFAYTApplyTables = 5; 345 wsAFAYTAutoLetterWizard = 6; 346 wsAFAYTDefineStyles = 7; 347 wsAFAYTFormatListItemBeginning = 8; 348 wsAFAYTInsertClosings = 9; 349 wsAFAYTReplaceQuotes = 10; 350 wsAFAYTReplaceFractions = 11; 351 wsAFAYTReplaceHyperlinks = 12; 352 wsAFAYTReplaceOrdinals = 13; 353 wsAFAYTReplacePlainTextEmphasis = 14; 354 wsAFAYTReplaceSymbols = 15; 355 wsAutoFormatReplaceQuotes = 16; 356 wsTabIndentKey = 17; 357 wsWindowState = 18; 358 wsSaveInterval = 19; 359 wsTrackRevisions = 20; 360 wsShowRevisions = 21; 361 wsShowSummary = 22; {not used for Word 2010; ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; added second parameter } 362 363 procedure TMSWordThread.Execute; 364 var 365 ok: boolean; 366 367 procedure EnableAppActivation; 368 begin 369 FWord.Caption := FTitle; 370 Synchronize(FindDocumentWindow); 371 end; 372 373 procedure Run(AMethod: TThreadMethod; force: boolean = false); 374 begin 375 if terminated then exit; 376 if ok or force then 377 begin 378 ok := RunWithErrorTrap(AMethod, TX_SPELL_ABORT, TX_GRAMMAR_ABORT, '', FALSE); 379 end; 380 end; 381 382 procedure BuildResultMessage; 383 begin 384 FResultMessage := ''; 385 if FCanceled or (not FSucceeded) then 386 begin 387 if FSpellCheck then 388 FResultMessage := TX_SPELL_CANCELLED 389 else 390 FResultMessage := TX_GRAMMAR_CANCELLED; 391 FResultMessage := FResultMessage + CRLF + TX_NO_CORRECTIONS; 392 end 393 else 394 if FSucceeded then 395 begin 396 if FSpellCheck then 397 FResultMessage := TX_SPELL_COMPLETE 398 else 399 FResultMessage := TX_GRAMMAR_COMPLETE; 400 end; 401 end; 402 403 procedure SetStatus(value, force: boolean); 404 begin 405 if ok or force then 406 begin 407 ThreadLock; 408 FSpellChecking := value; 409 ThreadUnlock; 410 end; 411 end; 412 413 begin 414 CoInitialize(nil); 415 ok := true; 416 try 417 if RunWithErrorTrap(StartWord, TX_NO_SPELL_CHECK, TX_NO_GRAMMAR_CHECK, TX_TRY_AGAIN, TRUE) then 418 begin 419 try 420 if RunWithErrorTrap(CreateDocument, TX_SPELL_ABORT, TX_GRAMMAR_ABORT, '', FALSE) then 421 begin 422 try 423 EnableAppActivation; 424 Run(SaveWordSettings); 425 Run(ConfigWord); 426 Run(ConfigDoc); 427 Run(GetDialogs); 428 Run(LoadUserSettings); 429 SetStatus(True, False); 430 Run(DoCheck); 431 SetStatus(False, True); 432 Run(SaveUserSettings); 433 Run(RestoreWordSettings); 434 Run(ExitWord, True); 435 if ok and (not terminated) then 436 begin 437 Synchronize(TransferText); 438 BuildResultMessage; 439 Synchronize(ReportResults); 440 end; 441 finally 442 FDoc := nil; 443 end; 444 end; 445 finally 446 FWord := nil; 447 end; 448 end; 449 finally 450 CoUninitialize; 451 end; 452 end; 453 454 procedure TMSWordThread.ExitWord; 455 var 456 Save: OleVariant; 457 Doc: OleVariant; 458 459 begin 460 VarClear(FDialog); 461 VarClear(FDocDlg); 462 VariantInit(Save); 463 VariantInit(Doc); 464 try 465 Save := wdDoNotSaveChanges; 466 Doc := wdWordDocument; 467 FWord.Quit(Save, Doc, FFalseVar); 468 finally 469 VarClear(Save); 470 VarClear(Doc); 471 end; 472 end; 473 474 var 475 WindowTitle: string; 476 WindowHandle: HWnd; 477 478 function FindDocWindow(Handle: HWND; Info: Pointer): BOOL; stdcall; 479 var 480 title: string; 481 begin 482 title := GetWindowTitle(Handle); 483 if title = WindowTitle then 484 begin 485 WindowHandle := Handle; 486 Result := FALSE; 487 end 488 else 489 Result := True; 490 end; 491 492 procedure TMSWordThread.FindDocumentWindow; 493 begin 494 WindowTitle := FTitle; 495 WindowHandle := 0; 496 EnumWindows(@FindDocWindow, 0); 497 FDocWindowHandle := WindowHandle; 498 end; 499 500 procedure TMSWordThread.GetDialogs; 501 //var 502 // DispParams: TDispParams; 503 // OleArgs: array of OleVariant; 504 // ExcepInfo: TExcepInfo; 505 // Status: integer; 506 begin 507 // SetLength(OleArgs, 1); 508 // VariantInit(OleArgs[0]); 509 // try 510 VariantInit(FDialog); 511 FDialog := FWord.Dialogs.Item(wdDialogToolsOptionsSpellingAndGrammar); 512 VariantInit(FDocDlg); 513 FDocDlg := FWord.ActiveDocument; 514 (* OleArgs[0] := wdDialogToolsOptionsSpellingAndGrammar; 515 DispParams.rgvarg := @OleArgs[0]; 516 DispParams.cArgs := 1; 517 DispParams.rgdispidNamedArgs := nil; 518 DispParams.cNamedArgs := 0; 519 // FDialog := FWord.Dialogs.Item(wdDialogToolsOptionsSpellingAndGrammar); 520 // dispid 0 is the Item method 521 Status := FWord.Dialogs.Invoke(0, GUID_NULL, LOCALE_USER_DEFAULT, 522 DISPATCH_METHOD or DISPATCH_PROPERTYGET, DispParams, @FDialog, @ExcepInfo, nil); 523 if Status <> S_OK then 524 DispatchInvokeError(Status, ExcepInfo); 525 VariantInit(FDocDlg); 526 DispParams.rgvarg := nil; 527 DispParams.cArgs := 0; 528 Status := FWord.Invoke(3, GUID_NULL, LOCALE_USER_DEFAULT, 529 DISPATCH_METHOD or DISPATCH_PROPERTYGET, DispParams, @FDocDlg, @ExcepInfo, nil); 530 if Status <> S_OK then 531 DispatchInvokeError(Status, ExcepInfo); 532 finally 533 VarClear(OleArgs[0]); 534 SetLength(OleArgs, 0); 535 end; *) 536 end; 537 538 procedure TMSWordThread.LoadUserSettings; 539 begin 540 // load FUserSettings from server 541 542 // these are default values 543 (* 544 9 AlwaysSuggest, 545 8 SuggestFromMainDictOnly, 546 5 IgnoreAllCaps, 547 4 IgnoreMixedDigits, 548 ResetIgnoreAll, 549 Type, CustomDict1, CustomDict2, CustomDict3, CustomDict4, CustomDict5, CustomDict6, 550 CustomDict7, CustomDict8, CustomDict9, CustomDict10, 551 1 AutomaticSpellChecking, 552 3 FilenamesEmailAliases, 553 UserDict1, 554 2 AutomaticGrammarChecking, 555 6?? ForegroundGrammar, 556 7 ShowStatistics, 557 Options, RecheckDocument, IgnoreAuxFind, IgnoreMissDictSearch, 558 10 HideGrammarErrors, 559 CheckSpelling, GrLidUI, SpLidUI, 560 DictLang1, DictLang2, DictLang3, 561 DictLang4, DictLang5, DictLang6, DictLang7, DictLang8, DictLang9, DictLang10, 562 11 HideSpellingErrors, 563 HebSpellStart, InitialAlefHamza, FinalYaa, GermanPostReformSpell, 564 AraSpeller, ProcessCompoundNoun 565 *) 566 // FDialog. 567 ThreadLock; 568 try 569 FDialog.AutomaticSpellChecking := UserSetting(usCheckSpellingAsYouType); 570 FDialog.AutomaticGrammarChecking := UserSetting(usCheckGrammarAsYouType); 571 FDialog.FilenamesEmailAliases := UserSetting(usIgnoreInternetAndFileAddresses); 572 FDialog.IgnoreMixedDigits := UserSetting(usIgnoreMixedDigits); 573 FDialog.ForegroundGrammar := UserSetting(usCheckGrammarWithSpelling); 574 FDialog.ShowStatistics := UserSetting(usShowReadabilityStatistics); 575 FDialog.SuggestFromMainDictOnly := UserSetting(usSuggestFromMainDictionaryOnly); 576 FDialog.IgnoreAllCaps := UserSetting(usIgnoreUppercase); 577 FDialog.AlwaysSuggest := UserSetting(usSuggestSpellingCorrections); 578 FDialog.HideSpellingErrors := UserSetting(usHideSpellingErrors); 579 FDialog.HideGrammarErrors := UserSetting(usHideGrammarErrors); 580 FDialog.Execute; 581 finally 582 ThreadUnlock; 583 end; 584 585 // need list of custom dictionaries - default to CUSTOM.DIC (or query Word for it!!!) 586 // FWord.CustomDictionaries 587 588 end; 589 590 procedure TMSWordThread.OnAppActivate(Sender: TObject); 591 begin 592 if assigned(FOldOnActivate) then 593 FOldOnActivate(Sender); 594 RefocusSpellCheckDialog; 595 end; 596 597 procedure TMSWordThread.OnFormChange(Sender: TObject); 598 begin 599 if assigned(FOldFormChange) then 600 FOldFormChange(Sender); 601 RefocusSpellCheckDialog; 602 end; 603 604 procedure TMSWordThread.OnThreadTerminate(Sender: TObject); 605 begin 606 Application.OnActivate := FOldOnActivate; 607 Screen.OnActiveFormChange := FOldFormChange; 608 // VarClear(FEmptyVar); 609 VarClear(FFalseVar); 610 // VarClear(FTrueVar); 611 FWordSettings.Free; 612 FBeforeLines.Free; 613 FAfterLines.Free; 614 DeleteCriticalSection(FLock); 615 Screen.Cursor := crDefault; 616 MSWordThread := nil; 617 end; 618 619 procedure TMSWordThread.RefocusSpellCheckDialog; 620 begin 621 Application.ProcessMessages; 622 if Application.Active and (not FShowingMessage) and (FDocWindowHandle <> 0) then 623 begin 624 SetForegroundWindow(FDocWindowHandle); 625 SetFocus(FDocWindowHandle); 626 end; 627 end; 628 629 procedure TMSWordThread.ReportResults; 630 var 631 icon: TShow508MessageIcon; 632 begin 633 if FSucceeded then 634 icon := smiInfo 635 else 636 icon := smiWarning; 637 FShowingMessage := True; 638 try 639 ShowMsg(FResultMessage, icon, smbOK); 640 finally 641 FShowingMessage := False; 642 end; 643 end; 644 645 procedure TMSWordThread.RestoreWordSettings; 646 647 function Load(Index: integer): integer; 648 begin 649 if FWordSettings.Count > Index then 650 Result := Integer(FWordSettings[Index]) 651 else 652 Result := 0 653 end; 654 655 begin 656 FWord.Options.AutoFormatAsYouTypeApplyBorders := boolean(Load(wsAFAYTApplyBorders)); 657 FWord.Options.AutoFormatAsYouTypeApplyBulletedLists := boolean(Load(wsAFAYTApplyBulletedLists)); 658 FWord.Options.AutoFormatAsYouTypeApplyFirstIndents := boolean(Load(wsAFAYTApplyFirstIndents)); 659 FWord.Options.AutoFormatAsYouTypeApplyHeadings := boolean(Load(wsAFAYTApplyHeadings)); 660 FWord.Options.AutoFormatAsYouTypeApplyNumberedLists := boolean(Load(wsAFAYTApplyNumberedLists)); 661 FWord.Options.AutoFormatAsYouTypeApplyTables := boolean(Load(wsAFAYTApplyTables)); 662 FWord.Options.AutoFormatAsYouTypeAutoLetterWizard := boolean(Load(wsAFAYTAutoLetterWizard)); 663 FWord.Options.AutoFormatAsYouTypeDefineStyles := boolean(Load(wsAFAYTDefineStyles)); 664 FWord.Options.AutoFormatAsYouTypeFormatListItemBeginning := boolean(Load(wsAFAYTFormatListItemBeginning)); 665 FWord.Options.AutoFormatAsYouTypeInsertClosings := boolean(Load(wsAFAYTInsertClosings)); 666 FWord.Options.AutoFormatAsYouTypeReplaceQuotes := boolean(Load(wsAFAYTReplaceQuotes)); 667 FWord.Options.AutoFormatAsYouTypeReplaceFractions := boolean(Load(wsAFAYTReplaceFractions)); 668 FWord.Options.AutoFormatAsYouTypeReplaceHyperlinks := boolean(Load(wsAFAYTReplaceHyperlinks)); 669 FWord.Options.AutoFormatAsYouTypeReplaceOrdinals := boolean(Load(wsAFAYTReplaceOrdinals)); 670 FWord.Options.AutoFormatAsYouTypeReplacePlainTextEmphasis := boolean(Load(wsAFAYTReplacePlainTextEmphasis)); 671 FWord.Options.AutoFormatAsYouTypeReplaceSymbols := boolean(Load(wsAFAYTReplaceSymbols)); 672 FWord.Options.AutoFormatReplaceQuotes := boolean(Load(wsAutoFormatReplaceQuotes)); 673 FWord.Options.TabIndentKey := boolean(Load(wsTabIndentKey)); 674 FWord.WindowState := Load(wsWindowState); 675 FWord.Options.SaveInterval := Load(wsSaveInterval); 676 FDoc.TrackRevisions := boolean(Load(wsTrackRevisions)); 677 FDoc.ShowRevisions := boolean(Load(wsShowRevisions)); 678 if (FWordVersion < 13) then {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Only call next line if office verion if version < office10} // altered for Word 2010 679 FDoc.ShowSummary := boolean(Load(wsShowSummary)); 680 end; 681 682 function TMSWordThread.RunWithErrorTrap(AMethod: TThreadMethod; 683 SpellCheckErrorMessage, GrammarCheckErrorMessage, 684 AdditionalErrorMessage: string; AllowRetry: boolean): boolean; 685 var 686 RetryCount: integer; 687 Done: boolean; 688 begin 689 RetryCount := 0; 690 Result := TRUE; 691 repeat 692 Done := TRUE; 693 try 694 AMethod; 695 except 696 on E: Exception do 223 697 begin 224 ErrMsg := E.Message; 225 FinishedChecking := False; 698 if not terminated then 699 begin 700 inc(RetryCount); 701 Done := FALSE; 702 if RetryCount >= RETRY_MAX then 703 begin 704 FError := E; 705 FAllowErrorRetry := AllowRetry; 706 if FSpellCheck then 707 FErrorText1 := SpellCheckErrorMessage 708 else 709 FErrorText1 := GrammarCheckErrorMessage; 710 FErrorText2 := AdditionalErrorMessage; 711 Synchronize(WordError); 712 if AllowRetry and (FRetryResult = smrRetry) then 713 RetryCount := 0 714 else 715 begin 716 Result := FALSE; 717 Done := TRUE; 718 end; 719 end; 720 end; 226 721 end; 227 end; 228 229 Screen.Cursor := crDefault; 230 Application.BringToFront; 231 if FinishedChecking then 722 end; 723 until Done; 724 end; 725 726 procedure TMSWordThread.DoCheck; 727 begin 728 FDoc.Content.Text := FText; 729 FDoc.Content.SpellingChecked := False; 730 FDoc.Content.GrammarChecked := False; 731 if FSpellCheck then 732 begin 733 FDocDlg.Content.CheckSpelling; 734 // FDoc.CheckSpelling(FNullStr, FEmptyVar, FEmptyVar, {Ignore, Suggest, }FNullStr, FNullStr, 735 // FNullStr, FNullStr, FNullStr, FNullStr, FNullStr, FNullStr, FNullStr); 736 FSucceeded := FDoc.Content.SpellingChecked; 737 FText := FDoc.Content.Text; 738 end 739 else 740 begin 741 FDoc.Content.CheckGrammar; 742 FSucceeded := FDoc.Content.GrammarChecked; 743 FText := FDoc.Content.Text; 744 end; 745 FCanceled := (FText = ''); 746 end; 747 748 procedure TMSWordThread.SaveUserSettings; 749 750 procedure SaveSetting(Value: boolean; Index: integer); 751 begin 752 while length(SpellCheckerSettings) < Index do 753 SpellCheckerSettings := SpellCheckerSettings + ' '; 754 if Value then 755 SpellCheckerSettings[Index] := sTrueCode 756 else 757 SpellCheckerSettings[Index] := sFalseCode; 758 end; 759 begin 760 ThreadLock; 761 try 762 SpellCheckerSettings := ''; 763 FDialog.Update; 764 SaveSetting(FDialog.AutomaticSpellChecking, usCheckSpellingAsYouType); 765 SaveSetting(FDialog.AutomaticGrammarChecking, usCheckGrammarAsYouType); 766 SaveSetting(FDialog.FilenamesEmailAliases, usIgnoreInternetAndFileAddresses); 767 SaveSetting(FDialog.IgnoreMixedDigits, usIgnoreMixedDigits); 768 SaveSetting(FDialog.IgnoreAllCaps, usIgnoreUppercase); 769 SaveSetting(FDialog.ForegroundGrammar, usCheckGrammarWithSpelling); 770 SaveSetting(FDialog.ShowStatistics, usShowReadabilityStatistics); 771 SaveSetting(FDialog.SuggestFromMainDictOnly, usSuggestFromMainDictionaryOnly); 772 SaveSetting(FDialog.AlwaysSuggest, usSuggestSpellingCorrections); 773 SaveSetting(FDialog.HideSpellingErrors, usHideSpellingErrors); 774 SaveSetting(FDialog.HideGrammarErrors, usHideGrammarErrors); 775 finally 776 ThreadUnlock; 777 end; 778 (* 779 9 AlwaysSuggest, 780 8 SuggestFromMainDictOnly, 781 5 IgnoreAllCaps, 782 4 IgnoreMixedDigits, 783 ResetIgnoreAll, 784 Type, CustomDict1, CustomDict2, CustomDict3, CustomDict4, CustomDict5, CustomDict6, 785 CustomDict7, CustomDict8, CustomDict9, CustomDict10, 786 1 AutomaticSpellChecking, 787 3 FilenamesEmailAliases, 788 UserDict1, 789 2 AutomaticGrammarChecking, 790 6?? ForegroundGrammar, 791 7 ShowStatistics, 792 Options, RecheckDocument, IgnoreAuxFind, IgnoreMissDictSearch, 793 10 HideGrammarErrors, 794 CheckSpelling, GrLidUI, SpLidUI, 795 DictLang1, DictLang2, DictLang3, 796 DictLang4, DictLang5, DictLang6, DictLang7, DictLang8, DictLang9, DictLang10, 797 11 HideSpellingErrors, 798 HebSpellStart, InitialAlefHamza, FinalYaa, GermanPostReformSpell, 799 AraSpeller, ProcessCompoundNoun 800 *) 801 end; 802 803 procedure TMSWordThread.SaveWordSettings; 804 805 procedure Save(Value, Index: integer); 806 begin 807 while FWordSettings.Count <= Index do 808 FWordSettings.Add(nil); 809 FWordSettings[Index] := Pointer(Value); 810 end; 811 812 begin 813 Save(Ord(FWord.Options.AutoFormatAsYouTypeApplyBorders) , wsAFAYTApplyBorders); 814 Save(Ord(FWord.Options.AutoFormatAsYouTypeApplyBulletedLists) , wsAFAYTApplyBulletedLists); 815 Save(Ord(FWord.Options.AutoFormatAsYouTypeApplyFirstIndents) , wsAFAYTApplyFirstIndents); 816 Save(Ord(FWord.Options.AutoFormatAsYouTypeApplyHeadings) , wsAFAYTApplyHeadings); 817 Save(Ord(FWord.Options.AutoFormatAsYouTypeApplyNumberedLists) , wsAFAYTApplyNumberedLists); 818 Save(Ord(FWord.Options.AutoFormatAsYouTypeApplyTables) , wsAFAYTApplyTables); 819 Save(Ord(FWord.Options.AutoFormatAsYouTypeAutoLetterWizard) , wsAFAYTAutoLetterWizard); 820 Save(Ord(FWord.Options.AutoFormatAsYouTypeDefineStyles) , wsAFAYTDefineStyles); 821 Save(Ord(FWord.Options.AutoFormatAsYouTypeFormatListItemBeginning) , wsAFAYTFormatListItemBeginning); 822 Save(Ord(FWord.Options.AutoFormatAsYouTypeInsertClosings) , wsAFAYTInsertClosings); 823 Save(Ord(FWord.Options.AutoFormatAsYouTypeReplaceQuotes) , wsAFAYTReplaceQuotes); 824 Save(Ord(FWord.Options.AutoFormatAsYouTypeReplaceFractions) , wsAFAYTReplaceFractions); 825 Save(Ord(FWord.Options.AutoFormatAsYouTypeReplaceHyperlinks) , wsAFAYTReplaceHyperlinks); 826 Save(Ord(FWord.Options.AutoFormatAsYouTypeReplaceOrdinals) , wsAFAYTReplaceOrdinals); 827 Save(Ord(FWord.Options.AutoFormatAsYouTypeReplacePlainTextEmphasis) , wsAFAYTReplacePlainTextEmphasis); 828 Save(Ord(FWord.Options.AutoFormatAsYouTypeReplaceSymbols) , wsAFAYTReplaceSymbols); 829 Save(Ord(FWord.Options.AutoFormatReplaceQuotes) , wsAutoFormatReplaceQuotes); 830 Save(Ord(FWord.Options.TabIndentKey) , wsTabIndentKey); 831 Save(Ord(FWord.WindowState) , wsWindowState); 832 Save(Ord(FWord.Options.SaveInterval) , wsSaveInterval); 833 Save(Ord(FDoc.TrackRevisions) , wsTrackRevisions); 834 Save(Ord(FDoc.ShowRevisions) , wsShowRevisions); 835 if (FWordVersion < 13) then {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Only call next line if office verion if version < office10} 836 Save(Ord(FDoc.ShowSummary) , wsShowSummary); 837 end; 838 839 procedure TMSWordThread.StartWord; 840 begin 841 FWord := CoWordApplication.Create; 842 FWordVersion := StrToFloatDef(FWord.Version, 0.0); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Get Office version for office10 specific calls} 843 end; 844 845 procedure TMSWordThread.ThreadLock; 846 begin 847 EnterCriticalSection(FLock); 848 end; 849 850 procedure TMSWordThread.ThreadUnlock; 851 begin 852 LeaveCriticalSection(FLock); 853 end; 854 855 procedure TMSWordThread.TransferText; 856 var 857 i: integer; 858 Lines: TStringList; 859 begin 860 if FSucceeded and (not FCanceled) then 861 begin 862 Lines := TStringList.Create; 863 try 864 Lines.Text := FText; 865 // For some unknown reason spell check adds garbage lines to text 866 while (Lines.Count > 0) and (trim(Lines[Lines.Count-1]) = '') do 867 Lines.Delete(Lines.Count-1); 868 for i := 0 to FBeforeLines.Count-1 do 869 Lines.Insert(i, FBeforeLines[i]); 870 for i := 0 to FAfterLines.Count-1 do 871 Lines.Add(FAfterLines[i]); 872 FastAssign(Lines, FEditControl.Lines); 873 finally 874 Lines.Free; 875 end; 876 end; 877 end; 878 879 function TMSWordThread.UserSetting(Index: integer): boolean; 880 begin 881 if SpellCheckerSettings = '' then 882 begin 883 case Index of 884 usCheckSpellingAsYouType: Result := True; 885 usCheckGrammarAsYouType: Result := False; 886 usIgnoreInternetAndFileAddresses: Result := True; 887 usIgnoreMixedDigits: Result := True; 888 usIgnoreUppercase: Result := True; 889 usCheckGrammarWithSpelling: Result := False; 890 usShowReadabilityStatistics: Result := False; 891 usSuggestFromMainDictionaryOnly: Result := False; 892 usSuggestSpellingCorrections: Result := True; 893 usHideSpellingErrors: Result := False; 894 usHideGrammarErrors: Result := True; 895 else Result := False; 896 end; 897 end 898 else 899 Result := copy(SpellCheckerSettings,Index,1) = sTrueCode; 900 end; 901 902 procedure TMSWordThread.ConfigDoc; 903 begin 904 FDoc.TrackRevisions := False; 905 FDoc.ShowRevisions := False; 906 if (FWordVersion < 13) then {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Only call next line if office verion if version < office10} 907 FDoc.ShowSummary := False; 908 FWord.Height := 1000; 909 FWord.Width := 1000; 910 FWord.Top := -2000; 911 FWord.Left := -2000; 912 end; 913 914 procedure TMSWordThread.ConfigWord; 915 begin 916 // save all old values to FWord, restore when done. 917 FWord.Options.AutoFormatAsYouTypeApplyBorders := False; 918 FWord.Options.AutoFormatAsYouTypeApplyBulletedLists := False; 919 FWord.Options.AutoFormatAsYouTypeApplyFirstIndents := False; 920 FWord.Options.AutoFormatAsYouTypeApplyHeadings := False; 921 FWord.Options.AutoFormatAsYouTypeApplyNumberedLists := False; 922 FWord.Options.AutoFormatAsYouTypeApplyTables := False; 923 FWord.Options.AutoFormatAsYouTypeAutoLetterWizard := False; 924 FWord.Options.AutoFormatAsYouTypeDefineStyles := False; 925 FWord.Options.AutoFormatAsYouTypeFormatListItemBeginning := False; 926 FWord.Options.AutoFormatAsYouTypeInsertClosings := False; 927 FWord.Options.AutoFormatAsYouTypeReplaceQuotes := False; 928 FWord.Options.AutoFormatAsYouTypeReplaceFractions := False; 929 FWord.Options.AutoFormatAsYouTypeReplaceHyperlinks := False; 930 FWord.Options.AutoFormatAsYouTypeReplaceOrdinals := False; 931 FWord.Options.AutoFormatAsYouTypeReplacePlainTextEmphasis := False; 932 FWord.Options.AutoFormatAsYouTypeReplaceSymbols := False; 933 FWord.Options.AutoFormatReplaceQuotes := False; 934 FWord.Options.TabIndentKey := False; 935 FWord.WindowState := wdWindowStateNormal; 936 FWord.Options.SaveInterval := 0; 937 FWord.ResetIgnoreAll; 938 end; 939 940 procedure TMSWordThread.CreateDocument; 941 var 942 DocType: OleVariant; 943 begin 944 VariantInit(DocType); 945 try 946 DocType := wdNewBlankDocument; 947 FDoc := FWord.Documents.Add(FNullStr, FFalseVar, DocType, FFalseVar); 948 {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Commented out following line as it would fail for office 10 and above and also not really required for previous versions} 949 // FDoc.Activate; 950 finally 951 VarClear(DocType); 952 end; 953 end; 954 955 constructor TMSWordThread.CreateThread(SpellCheck: boolean; AEditControl: TCustomMemo); 956 957 function WordDocTitle: string; 958 var 959 Guid: TGUID; 960 begin 961 if ActiveX.Succeeded(CreateGUID(Guid)) then 962 Result := GUIDToString(Guid) 963 else 964 Result := ''; 965 Result := TX_WINDOW_TITLE + IntToStr(Application.Handle) + '/' + Result; 966 end; 967 968 function BeforeLineInvalid(Line: string): boolean; 969 var 970 i: integer; 971 begin 972 Result := (trim(Line) = ''); 973 if not Result then 232 974 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 := '' 975 for I := 1 to length(Line) do 976 if pos(Line[i], VALID_STARTING_CHARS) > 0 then exit; 977 Result := True; 978 end; 979 end; 980 981 procedure GetTextFromComponent; 982 var 983 Lines: TStrings; 984 begin 985 Lines := TStringList.Create; 986 try 987 FastAssign(AEditControl.Lines, Lines); 988 989 while (Lines.Count > 0) and (trim(Lines[Lines.Count-1]) = '') do 990 begin 991 FAfterLines.Insert(0, Lines[Lines.Count-1]); 992 Lines.Delete(Lines.Count-1); 270 993 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 994 995 while (Lines.Count > 0) and (BeforeLineInvalid(Lines[0])) do 996 begin 997 FBeforeLines.Add(Lines[0]); 998 Lines.Delete(0); 999 end; 1000 1001 FText := Lines.Text; 1002 finally 1003 Lines.Free; 1004 end; 1005 end; 1006 1007 begin 1008 inherited Create(TRUE); 1009 Screen.Cursor := crHourGlass; 1010 InitializeCriticalSection(FLock); 1011 FBeforeLines := TStringList.Create; 1012 FAfterLines := TStringList.Create; 1013 FWordSettings := TList.Create; 1014 FSpellChecking := False; 1015 FEditControl := AEditControl; 1016 // VariantInit(FEmptyVar); 1017 VariantInit(FFalseVar); 1018 // VariantInit(FTrueVar); 1019 VariantInit(FNullStr); 1020 // TVarData(FEmptyVar).VType := VT_EMPTY; 1021 TVarData(FFalseVar).VType := VT_BOOL; 1022 // TVarData(FTrueVar).VType := VT_BOOL; 1023 TVarData(FNullStr).VType := VT_BSTR; 1024 // FEmptyVar := 0; 1025 FFalseVar := 0; 1026 // FTrueVar := -1; 1027 FNullStr := ''; 1028 FDocWindowHandle := 0; 1029 FSpellCheck := SpellCheck; 1030 1031 GetTextFromComponent; 1032 1033 FSucceeded := FALSE; 1034 FCanceled := FALSE; 1035 FTitle := WordDocTitle; 1036 FreeOnTerminate := True; 1037 OnTerminate := OnThreadTerminate; 1038 FOldOnActivate := Application.OnActivate; 1039 Application.OnActivate := OnAppActivate; 1040 FOldFormChange := Screen.OnActiveFormChange; 1041 Screen.OnActiveFormChange := OnFormChange; 1042 Resume; 1043 end; 1044 1045 procedure TMSWordThread.WordError; 1046 var 1047 btn: TShow508MessageButton; 1048 msg: string; 1049 1050 procedure Append(txt: string); 1051 begin 1052 if txt <> '' then 1053 msg := msg + CRLF + txt; 1054 end; 1055 1056 begin 1057 if FAllowErrorRetry then 1058 btn := smbRetryCancel 1059 else 1060 btn := smbOK; 1061 msg := TX_ERROR_INTRO; 1062 Append(FErrorText1); 1063 if FError.Message <> '' then 1064 Append(FError.Message) 1065 else 1066 Append(TX_NO_DETAILS); 1067 Append(FErrorText2); 1068 FShowingMessage := True; 1069 try 1070 FRetryResult := ShowMsg(Msg, TX_ERROR_TITLE, smiError, btn); 1071 finally 1072 FShowingMessage := False; 1073 end; 1074 end; 1075 1076 initialization 1077 1078 finalization 1079 KillSpellCheck; 290 1080 291 1081 end.
Note:
See TracChangeset
for help on using the changeset viewer.