Changeset 1705


Ignore:
Timestamp:
May 9, 2015, 7:42:17 AM (10 years ago)
Author:
healthsevak
Message:

updated this file to version 28,
did minor changes for making it compatible with MS Office 10
and Implemented the OpenSource based spell check feature

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/branches/HealthSevak-CPRS/CPRS-Chart/uSpell.pas

    r841 r1705  
    11unit uSpell;
    2 
     2// Word settings need to be restored to origional settings!
    33{$O-}
     4
     5{$DEFINE CPRS}
     6{$UNDEF CPRS}
    47
    58interface
    … …  
    710uses
    811  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;
    1013
    1114type
    12 
    1315  TSpellCheckAvailable = record
    1416    Evaluated: boolean;
    … …  
    1618  end;
    1719
    18 function  SpellCheckAvailable: Boolean;
    1920function  SpellCheckInProgress: Boolean;
    2021procedure KillSpellCheck;
    21 procedure SpellCheckForControl(AnEditControl: TCustomMemo);
     22function  SpellCheckAvailable: Boolean;
     23procedure SpellCheckForControl(AnEditControl: TCustomMemo; OpenSource: Boolean = False);  {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine ; added 2nd parameter}
    2224procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
    2325
    24 implementation
     26// Do Not Call these routines - internal use only
     27procedure InternalSpellCheck(SpellCheck: boolean; EditControl: TCustomMemo);
     28procedure RefocusSpellCheckWindow;
    2529
    2630const
    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}
    2834  TX_NO_SPELL_CHECK     = 'Spell checking is unavailable.';
    2935  TX_NO_GRAMMAR_CHECK   = 'Grammar checking is unavailable.';
    … …  
    3440  TX_SPELL_CANCELLED    = 'Spelling check was cancelled before completion.';
    3541  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
     47var
     48  SpellCheckerSettings: string = '';
     49
     50 
     51implementation
     52
     53uses VAUtils, fSpellNotify, uInit, fHunSpell;
     54
     55const
     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.';
    3671  TX_NO_DETAILS         = 'No further details are available.';
    3772  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
     79type
     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
     146var
     147  MSWordThread: TMSWordThread = nil;
     148
     149function ControlHasText(SpellCheck: boolean; AnEditControl: TCustomMemo): boolean;
     150var
     151  i: integer;
     152begin
     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
    56159    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
    99161      begin
    100         Application.ProcessMessages;
    101         SetForegroundWindow(HWND(NewList[i]));
     162        Result := TRUE;
    102163        break;
    103164      end;
    104165    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;
     174end;
     175
     176function SpellCheckInProgress: boolean;
     177begin
     178  Result := assigned(MSWordThread);
     179end;
     180
     181var
     182  uSpellCheckAvailable: TSpellCheckAvailable;
     183
     184procedure KillSpellCheck;
     185var
     186  checking: boolean;
     187  WordHandle: HWnd;
     188  ProcessID: DWORD;
     189  ProcessHandle: THandle;
     190 
     191begin
     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;
     223end;
     224
    107225
    108226{ Spell Checking using Visual Basic for Applications script }
    … …  
    128246end;
    129247
    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}
     249procedure DoHanSpellCheck(anEditControl: TCustomMemo);
     250//Initiates OpenSource (HunSpell) based Spell check
     251begin
     252  SuspendTimeout;
    149253  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;
     259end;
     260
     261procedure DoSpellCheck(SpellCheck: boolean; AnEditControl: TCustomMemo; OpenSource: Boolean = False); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Added second parameter}
     262var
     263  frmSpellNotify: TfrmSpellNotify;
     264begin
     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);
    150278    try
    151       GetWindowList(OldList);
     279      SuspendTimeout;
    152280      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;
    207284      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;
    216286      end;
    217287    finally
    218       OldList.Free;
    219       NewList.Free;
    220     end;
    221   except
    222     on E: Exception do
     288      frmSpellNotify.Free;
     289    end;
     290  end;
     291end;
     292
     293procedure InternalSpellCheck(SpellCheck: boolean; EditControl: TCustomMemo);
     294begin
     295  MSWordThread := TMSWordThread.CreateThread(SpellCheck, EditControl);
     296  while assigned(MSWordThread) do
     297  begin
     298    Application.ProcessMessages;
     299    sleep(50);
     300  end;
     301end;
     302
     303procedure RefocusSpellCheckWindow;
     304begin
     305  if assigned(MSWordThread) then
     306    MSWordThread.RefocusSpellCheckDialog;
     307end;
     308
     309procedure SpellCheckForControl(AnEditControl: TCustomMemo; OpenSource: Boolean = False); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; added second parameter}
     310begin
     311  DoSpellCheck(True, AnEditControl, OpenSource); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; added second parameter}
     312end;
     313
     314procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
     315begin
     316  DoSpellCheck(False, AnEditControl);
     317end;
     318{ TMSWordThread }
     319
     320const
     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
     363procedure TMSWordThread.Execute;
     364var
     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
     413begin
     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;
     452end;
     453
     454procedure TMSWordThread.ExitWord;
     455var
     456  Save: OleVariant;
     457  Doc: OleVariant;
     458
     459begin
     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;
     472end;
     473
     474var
     475  WindowTitle: string;
     476  WindowHandle: HWnd;
     477
     478function FindDocWindow(Handle: HWND; Info: Pointer): BOOL; stdcall;
     479var
     480  title: string;
     481begin
     482  title := GetWindowTitle(Handle);
     483  if title = WindowTitle then
     484  begin
     485    WindowHandle := Handle;
     486    Result := FALSE;
     487  end
     488  else
     489    Result := True;
     490end;
     491
     492procedure TMSWordThread.FindDocumentWindow;
     493begin
     494  WindowTitle := FTitle;
     495  WindowHandle := 0;
     496  EnumWindows(@FindDocWindow, 0);
     497  FDocWindowHandle := WindowHandle;
     498end;
     499
     500procedure TMSWordThread.GetDialogs;
     501//var
     502//  DispParams: TDispParams;
     503//  OleArgs: array of OleVariant;
     504//  ExcepInfo: TExcepInfo;
     505//  Status: integer;
     506begin
     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;                                       *)
     536end;
     537
     538procedure TMSWordThread.LoadUserSettings;
     539begin
     540  // load FUserSettings from server
     541
     542  // these are default values
     543  (*
     5449  AlwaysSuggest,
     5458  SuggestFromMainDictOnly,
     5465  IgnoreAllCaps,
     5474  IgnoreMixedDigits,
     548  ResetIgnoreAll,
     549  Type, CustomDict1, CustomDict2, CustomDict3, CustomDict4, CustomDict5, CustomDict6,
     550  CustomDict7, CustomDict8, CustomDict9, CustomDict10,
     5511  AutomaticSpellChecking,
     5523  FilenamesEmailAliases,
     553  UserDict1,
     5542  AutomaticGrammarChecking,
     5556??  ForegroundGrammar,
     5567  ShowStatistics,
     557  Options, RecheckDocument, IgnoreAuxFind, IgnoreMissDictSearch,
     55810  HideGrammarErrors,
     559  CheckSpelling, GrLidUI, SpLidUI,
     560  DictLang1, DictLang2, DictLang3,
     561  DictLang4, DictLang5, DictLang6, DictLang7, DictLang8, DictLang9, DictLang10,
     56211  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
     588end;
     589
     590procedure TMSWordThread.OnAppActivate(Sender: TObject);
     591begin
     592  if assigned(FOldOnActivate) then
     593    FOldOnActivate(Sender);
     594  RefocusSpellCheckDialog;
     595end;
     596
     597procedure TMSWordThread.OnFormChange(Sender: TObject);
     598begin
     599  if assigned(FOldFormChange) then
     600    FOldFormChange(Sender);
     601  RefocusSpellCheckDialog;
     602end;
     603
     604procedure TMSWordThread.OnThreadTerminate(Sender: TObject);
     605begin
     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;
     617end;
     618
     619procedure TMSWordThread.RefocusSpellCheckDialog;
     620begin
     621  Application.ProcessMessages;
     622  if Application.Active and (not FShowingMessage) and (FDocWindowHandle <> 0) then
     623  begin
     624    SetForegroundWindow(FDocWindowHandle);
     625    SetFocus(FDocWindowHandle);
     626  end;
     627end;
     628
     629procedure TMSWordThread.ReportResults;
     630var
     631  icon: TShow508MessageIcon;
     632begin
     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;
     643end;
     644
     645procedure 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
     655begin
     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));
     680end;
     681
     682function TMSWordThread.RunWithErrorTrap(AMethod: TThreadMethod;
     683  SpellCheckErrorMessage, GrammarCheckErrorMessage,
     684  AdditionalErrorMessage: string; AllowRetry: boolean): boolean;
     685var
     686  RetryCount: integer;
     687  Done: boolean;
     688begin
     689  RetryCount := 0;
     690  Result := TRUE;
     691  repeat
     692    Done := TRUE;
     693    try
     694      AMethod;
     695    except
     696      on E: Exception do
    223697      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;
    226721      end;
    227   end;
    228 
    229   Screen.Cursor := crDefault;
    230   Application.BringToFront;
    231   if FinishedChecking then
     722    end;
     723  until Done;
     724end;
     725
     726procedure TMSWordThread.DoCheck;
     727begin
     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 = '');
     746end;
     747
     748procedure 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;
     759begin
     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     (*
     7799  AlwaysSuggest,
     7808  SuggestFromMainDictOnly,
     7815  IgnoreAllCaps,
     7824  IgnoreMixedDigits,
     783  ResetIgnoreAll,
     784  Type, CustomDict1, CustomDict2, CustomDict3, CustomDict4, CustomDict5, CustomDict6,
     785  CustomDict7, CustomDict8, CustomDict9, CustomDict10,
     7861  AutomaticSpellChecking,
     7873  FilenamesEmailAliases,
     788  UserDict1,
     7892  AutomaticGrammarChecking,
     7906??  ForegroundGrammar,
     7917  ShowStatistics,
     792  Options, RecheckDocument, IgnoreAuxFind, IgnoreMissDictSearch,
     79310  HideGrammarErrors,
     794  CheckSpelling, GrLidUI, SpLidUI,
     795  DictLang1, DictLang2, DictLang3,
     796  DictLang4, DictLang5, DictLang6, DictLang7, DictLang8, DictLang9, DictLang10,
     79711  HideSpellingErrors,
     798  HebSpellStart, InitialAlefHamza, FinalYaa, GermanPostReformSpell,
     799  AraSpeller, ProcessCompoundNoun
     800  *)
     801end;
     802
     803procedure 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
     812begin
     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);
     837end;
     838
     839procedure TMSWordThread.StartWord;
     840begin
     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}         
     843end;
     844
     845procedure TMSWordThread.ThreadLock;
     846begin
     847  EnterCriticalSection(FLock);
     848end;
     849
     850procedure TMSWordThread.ThreadUnlock;
     851begin
     852  LeaveCriticalSection(FLock);
     853end;
     854
     855procedure TMSWordThread.TransferText;
     856var
     857  i: integer;
     858  Lines: TStringList;
     859begin
     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;
     877end;
     878
     879function TMSWordThread.UserSetting(Index: integer): boolean;
     880begin
     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;
     900end;
     901
     902procedure TMSWordThread.ConfigDoc;
     903begin
     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;
     912end;
     913
     914procedure TMSWordThread.ConfigWord;
     915begin
     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;
     938end;
     939
     940procedure TMSWordThread.CreateDocument;
     941var
     942  DocType: OleVariant;
     943begin
     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;
     953end;
     954
     955constructor 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
    232974    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);
    270993      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
     1007begin
     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;
     1043end;
     1044
     1045procedure TMSWordThread.WordError;
     1046var
     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
     1056begin
     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;
     1074end;
     1075
     1076initialization
     1077
     1078finalization
     1079  KillSpellCheck;
    2901080
    2911081end.
Note: See TracChangeset for help on using the changeset viewer.