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