Ignore:
Timestamp:
May 7, 2015, 12:34:29 PM (10 years ago)
Author:
healthsevak
Message:

Updating the working copy to CPRS version 28

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/uSpell.pas

    r841 r1679  
    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    fHunSpell.TfrmHunSpell.DoHunSpellCheck(AnEditControl);
     255  finally
     256    ResumeTimeout;
     257  end;
     258end;
     259
     260procedure DoSpellCheck(SpellCheck: boolean; AnEditControl: TCustomMemo; OpenSource: Boolean = False); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; Added second parameter}
     261var
     262  frmSpellNotify: TfrmSpellNotify;
     263begin
     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);
    150277    try
    151       GetWindowList(OldList);
     278      SuspendTimeout;
    152279      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 := '';
     280        frmSpellNotify.SpellCheck := SpellCheck;
     281        frmSpellNotify.EditControl := AnEditControl;
     282        frmSpellNotify.ShowModal;
    207283      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);
     284        ResumeTimeout;
    216285      end;
    217286    finally
    218       OldList.Free;
    219       NewList.Free;
    220     end;
    221   except
    222     on E: Exception do
     287      frmSpellNotify.Free;
     288    end;
     289  end;
     290end;
     291
     292procedure InternalSpellCheck(SpellCheck: boolean; EditControl: TCustomMemo);
     293begin
     294  MSWordThread := TMSWordThread.CreateThread(SpellCheck, EditControl);
     295  while assigned(MSWordThread) do
     296  begin
     297    Application.ProcessMessages;
     298    sleep(50);
     299  end;
     300end;
     301
     302procedure RefocusSpellCheckWindow;
     303begin
     304  if assigned(MSWordThread) then
     305    MSWordThread.RefocusSpellCheckDialog;
     306end;
     307
     308procedure SpellCheckForControl(AnEditControl: TCustomMemo; OpenSource: Boolean = False); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; added second parameter}
     309begin
     310  DoSpellCheck(True, AnEditControl, OpenSource); {ska@WorldVista ; 01 May 2015; to implement OpenSource SpellCheck Engine; added second parameter}
     311end;
     312
     313procedure GrammarCheckForControl(AnEditControl: TCustomMemo);
     314begin
     315  DoSpellCheck(False, AnEditControl);
     316end;
     317{ TMSWordThread }
     318
     319const
     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
     362procedure TMSWordThread.Execute;
     363var
     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
     412begin
     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
     418      try
     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
     435            begin
     436              Synchronize(TransferText);
     437              BuildResultMessage;
     438              Synchronize(ReportResults);
     439            end;
     440          finally
     441            FDoc := nil;
     442          end;
     443        end;
     444      finally
     445        FWord := nil;
     446      end;
     447    end;
     448  finally
     449    CoUninitialize;
     450  end;
     451end;
     452
     453procedure TMSWordThread.ExitWord;
     454var
     455  Save: OleVariant;
     456  Doc: OleVariant;
     457
     458begin
     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;
     471end;
     472
     473var
     474  WindowTitle: string;
     475  WindowHandle: HWnd;
     476
     477function FindDocWindow(Handle: HWND; Info: Pointer): BOOL; stdcall;
     478var
     479  title: string;
     480begin
     481  title := GetWindowTitle(Handle);
     482  if title = WindowTitle then
     483  begin
     484    WindowHandle := Handle;
     485    Result := FALSE;
     486  end
     487  else
     488    Result := True;
     489end;
     490
     491procedure TMSWordThread.FindDocumentWindow;
     492begin
     493  WindowTitle := FTitle;
     494  WindowHandle := 0;
     495  EnumWindows(@FindDocWindow, 0);
     496  FDocWindowHandle := WindowHandle;
     497end;
     498
     499procedure TMSWordThread.GetDialogs;
     500//var
     501//  DispParams: TDispParams;
     502//  OleArgs: array of OleVariant;
     503//  ExcepInfo: TExcepInfo;
     504//  Status: integer;
     505begin
     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;                                       *)
     535end;
     536
     537procedure TMSWordThread.LoadUserSettings;
     538begin
     539  // load FUserSettings from server
     540
     541  // these are default values
     542  (*
     5439  AlwaysSuggest,
     5448  SuggestFromMainDictOnly,
     5455  IgnoreAllCaps,
     5464  IgnoreMixedDigits,
     547  ResetIgnoreAll,
     548  Type, CustomDict1, CustomDict2, CustomDict3, CustomDict4, CustomDict5, CustomDict6,
     549  CustomDict7, CustomDict8, CustomDict9, CustomDict10,
     5501  AutomaticSpellChecking,
     5513  FilenamesEmailAliases,
     552  UserDict1,
     5532  AutomaticGrammarChecking,
     5546??  ForegroundGrammar,
     5557  ShowStatistics,
     556  Options, RecheckDocument, IgnoreAuxFind, IgnoreMissDictSearch,
     55710  HideGrammarErrors,
     558  CheckSpelling, GrLidUI, SpLidUI,
     559  DictLang1, DictLang2, DictLang3,
     560  DictLang4, DictLang5, DictLang6, DictLang7, DictLang8, DictLang9, DictLang10,
     56111  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
     587end;
     588
     589procedure TMSWordThread.OnAppActivate(Sender: TObject);
     590begin
     591  if assigned(FOldOnActivate) then
     592    FOldOnActivate(Sender);
     593  RefocusSpellCheckDialog;
     594end;
     595
     596procedure TMSWordThread.OnFormChange(Sender: TObject);
     597begin
     598  if assigned(FOldFormChange) then
     599    FOldFormChange(Sender);
     600  RefocusSpellCheckDialog;
     601end;
     602
     603procedure TMSWordThread.OnThreadTerminate(Sender: TObject);
     604begin
     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);
     614  Screen.Cursor := crDefault;
     615  MSWordThread := nil;
     616end;
     617
     618procedure TMSWordThread.RefocusSpellCheckDialog;
     619begin
     620  Application.ProcessMessages;
     621  if Application.Active and (not FShowingMessage) and (FDocWindowHandle <> 0) then
     622  begin
     623    SetForegroundWindow(FDocWindowHandle);
     624    SetFocus(FDocWindowHandle);
     625  end;
     626end;
     627
     628procedure TMSWordThread.ReportResults;
     629var
     630  icon: TShow508MessageIcon;
     631begin
     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;
     642end;
     643
     644procedure 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
     654begin
     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));
     679end;
     680
     681function TMSWordThread.RunWithErrorTrap(AMethod: TThreadMethod;
     682  SpellCheckErrorMessage, GrammarCheckErrorMessage,
     683  AdditionalErrorMessage: string; AllowRetry: boolean): boolean;
     684var
     685  RetryCount: integer;
     686  Done: boolean;
     687begin
     688  RetryCount := 0;
     689  Result := TRUE;
     690  repeat
     691    Done := TRUE;
     692    try
     693      AMethod;
     694    except
     695      on E: Exception do
    223696      begin
    224         ErrMsg := E.Message;
    225         FinishedChecking := False;
     697        if not terminated then
     698        begin
     699          inc(RetryCount);
     700          Done := FALSE;
     701          if RetryCount >= RETRY_MAX then
     702          begin
     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
     714            begin
     715              Result := FALSE;
     716              Done := TRUE;
     717            end;
     718          end;
     719        end;
    226720      end;
    227   end;
    228 
    229   Screen.Cursor := crDefault;
    230   Application.BringToFront;
    231   if FinishedChecking then
     721    end;
     722  until Done;
     723end;
     724
     725procedure TMSWordThread.DoCheck;
     726begin
     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 = '');
     745end;
     746
     747procedure 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;
     758begin
     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     (*
     7789  AlwaysSuggest,
     7798  SuggestFromMainDictOnly,
     7805  IgnoreAllCaps,
     7814  IgnoreMixedDigits,
     782  ResetIgnoreAll,
     783  Type, CustomDict1, CustomDict2, CustomDict3, CustomDict4, CustomDict5, CustomDict6,
     784  CustomDict7, CustomDict8, CustomDict9, CustomDict10,
     7851  AutomaticSpellChecking,
     7863  FilenamesEmailAliases,
     787  UserDict1,
     7882  AutomaticGrammarChecking,
     7896??  ForegroundGrammar,
     7907  ShowStatistics,
     791  Options, RecheckDocument, IgnoreAuxFind, IgnoreMissDictSearch,
     79210  HideGrammarErrors,
     793  CheckSpelling, GrLidUI, SpLidUI,
     794  DictLang1, DictLang2, DictLang3,
     795  DictLang4, DictLang5, DictLang6, DictLang7, DictLang8, DictLang9, DictLang10,
     79611  HideSpellingErrors,
     797  HebSpellStart, InitialAlefHamza, FinalYaa, GermanPostReformSpell,
     798  AraSpeller, ProcessCompoundNoun
     799  *)
     800end;
     801
     802procedure TMSWordThread.SaveWordSettings;
     803
     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
     811begin
     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);
     836end;
     837
     838procedure TMSWordThread.StartWord;
     839begin
     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}         
     842end;
     843
     844procedure TMSWordThread.ThreadLock;
     845begin
     846  EnterCriticalSection(FLock);
     847end;
     848
     849procedure TMSWordThread.ThreadUnlock;
     850begin
     851  LeaveCriticalSection(FLock);
     852end;
     853
     854procedure TMSWordThread.TransferText;
     855var
     856  i: integer;
     857  Lines: TStringList;
     858begin
     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;
     876end;
     877
     878function TMSWordThread.UserSetting(Index: integer): boolean;
     879begin
     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;
     899end;
     900
     901procedure TMSWordThread.ConfigDoc;
     902begin
     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;
     911end;
     912
     913procedure TMSWordThread.ConfigWord;
     914begin
     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;
     937end;
     938
     939procedure TMSWordThread.CreateDocument;
     940var
     941  DocType: OleVariant;
     942begin
     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;
     952end;
     953
     954constructor 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
    232973    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 := ''
     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);
    270992      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 
     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
     1006begin
     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;
     1042end;
     1043
     1044procedure TMSWordThread.WordError;
     1045var
     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
     1055begin
     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;
     1073end;
     1074
     1075initialization
     1076
     1077finalization
     1078  KillSpellCheck;
    2901079
    2911080end.
Note: See TracChangeset for help on using the changeset viewer.