Spellcheck with MS Word

General TRichView support forum. Please post your questions here
Post Reply
dkounal
Posts: 24
Joined: Sat Aug 27, 2005 4:51 pm
Location: Greece

Spellcheck with MS Word

Post by dkounal »

Fishing for a way to have greek spellchecking I found the following:
http://www.delphi3000.com/articles/article_1712.asp?SK=
http://www.delphi3000.com/articles/article_1707.asp?SK=

Have anyone tried it with Trichview?

Code: Select all

unit SpellChk;

//http://www.delphi3000.com/articles/article_1712.asp?SK=
//http://www.delphi3000.com/articles/article_1707.asp?SK=

// This is the VCL for Spell Checking and Synonyms using MS Word COM interface.
// It can correct and replace words in a text string,TMemo or TRichEdit using a
// built in replacement editor, or can be controlled by user dialog. I see there
// are other callable functions in the interface, which I have not implemented.
// Anyone see a use for any of them ?.

//    property PartOfSpeechList: OleVariant read Get_PartOfSpeechList;
//    property AntonymList: OleVariant      read Get_AntonymList;
//    property RelatedExpressionList: OleVariant  read Get_RelatedExpressionList;
//    property RelatedWordList: OleVariant        read Get_RelatedWordList;
//
//This is a very new component so any bug reports or improvements are welcome.
//
//Example of checking and changing a Memo text ...
//
//    SpellCheck.CheckMemoTextSpelling(Memo1);
//
//Properties
//----------------
//LetterChars - Characters considered to be letters. default is  ['A'..'Z','a'..'z'] (English)
//but could be changed to ['A'..'Z','a'..'z','a'','e'','i'','o'','u''] (Spanish) -
//Thanks to Mauricio Herrera for pointing this out.
//Color - Backgound color of Default dialog Editbox and Listbox
//CompletedMessage - enable/disable display of completed and count message dialog
//Font - Font of Default dialog Editbox and Listbox
//Language - Language used by GetSynonyms() method
//ReplaceDialog - Use Default replace dialog or User defined (see events)
//Active - Readonly, set at create time. Indicates if MS Word is available
//
//Methods
//----------------
//function GetSynonyms(StrWord : string; Synonyms : TStrings) : boolean;
//         True if synonyms found for StrWord. Synonyms List is returned in TStrings (Synonyms).
//
//function CheckWordSpelling(StrWord : string; Suggestions : TStrings) : boolean;
//         True if StrWord is spelt correctly. Suggested corrections returned in TStrings (Suggestions)
//
//procedure CheckTextSpelling(var StrText : string);
//          Proccesses string StrText and allows users to change mispelt words
//          via a Default replacement dialog or User defined calls. Words are changed
//          and returned in StrText.  Words in the text are changed automatically
//          by the Default editor. Use the  events if you want to control the dialog
//          yourself. ie. Get the mispelt word, give a choice of sugesstions (BeforeCorrection),
//          Change the word to corrected  (OnCorrection) and possibly display "Was/Now"  (AfterCorrection)
//
//procedure CheckRichTextSpelling(RichEdit : TRichEdit);
//         Corrects misspelt words directly in TRichEdit.Text. Rich Format is maintained.
//
//procedure CheckMemoTextSpelling(Memo : TMemo);
//         Corrects misspelt words directly into a TMemo.Text.
//
//Events (Mainly used when ReplaceDialog = repUser)
//--------------------------------------------------------------------------------
//BeforeCorrection - Supplies the mispelt word along with a TStrings var containing suggested corrections.
//
//OnCorrection - Supplies the mispelt word as a VAR type allowing user to change it
//               to desired word. The word will be replaced by this variable in the passed StrText.
//
//AfterCorrection - Supplies the mispelt word and what it has been changed to.
//

interface

// =============================================================================
// MS Word COM Interface to Spell Check and Synonyms
// Mike Heydon Dec 2000
// [email protected]
// =============================================================================

uses Windows,SysUtils,Classes,ComObj,Dialogs,Forms,StdCtrls,Controls,Buttons,Graphics,ComCtrls;

type
  // Event definitions
  TSpellCheckBeforeCorrection = procedure(Sender : TObject; MispeltWord : string; Suggestions : TStrings) of object;
  TSpellCheckAfterCorrection  = procedure(Sender : TObject; MispeltWord : string; CorrectedWord : string) of object;
  TSpellCheckOnCorrection     = procedure(Sender : TObject; var WordToCorrect : string) of object;

  // Property types
  TSpellCheckReplacement = (repDefault,repUser);
  TSpellCheckLetters = set of char;

  TSpellCheckLanguage = (wdLanguageNone, wdNoProofing, wdDanish, wdGerman, wdSwissGerman,
                         wdEnglishAUS, wdEnglishUK, wdEnglishUS, wdEnglishCanadian,
                         wdEnglishNewZealand,wdEnglishSouthAfrica, wdSpanish, wdFrench,
                         wdFrenchCanadian, wdItalian, wdDutch, wdNorwegianBokmol,
                         wdNorwegianNynorsk, wdBrazilianPortuguese, wdPortuguese,
                         wdFinnish, wdSwedish, wdCatalan, wdGreek, wdTurkish, wdRussian,
                         wdCzech, wdHungarian, wdPolish, wdSlovenian, wdBasque,
                         wdMalaysian, wdJapanese, wdKorean, wdSimplifiedChinese,
                         wdTraditionalChinese, wdSwissFrench, wdSesotho, wdTsonga,
                         wdTswana, wdVenda, wdXhosa, wdZulu, wdAfrikaans, wdArabic,
                         wdHebrew, wdSlovak, wdFarsi, wdRomanian, wdCroatian, wdUkrainian,
                         wdByelorussian, wdEstonian, wdLatvian, wdMacedonian,
                         wdSerbianLatin, wdSerbianCyrillic, wdIcelandic,
                         wdBelgianFrench, wdBelgianDutch, wdBulgarian,
                         wdMexicanSpanish, wdSpanishModernSort, wdSwissItalian);


  // Main TSpellcheck Class
  TSpellCheck = class(TComponent)
  private
    MsWordApp,MsSuggestions:OleVariant; FLetterChars:TSpellCheckLetters;
    FFont:TFont; FColor:TColor; FReplaceDialog:TSpellCheckReplacement;
    FCompletedMessage,FActive:boolean; FLanguage:TSpellCheckLanguage;
    FForm:TForm; FEbox:TEdit; FLbox:TListBox; FCancelBtn,FChangeBtn:TBitBtn;
    FBeforeCorrection:TSpellCheckBeforeCorrection;
    FAfterCorrection:TSpellCheckAfterCorrection;
    FOnCorrection : TSpellCheckOnCorrection;
    procedure SetFFont(NewValue:TFont);
  protected
    procedure MakeForm;
    procedure CloseForm;
    procedure SuggestedClick(Sender:TObject);
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    function GetSynonyms(StrWord:string; Synonyms:TStrings):boolean;
    function CheckWordSpelling(StrWord:string; Suggestions:TStrings):boolean;
    procedure CheckTextSpelling(var StrText:string);
    procedure CheckRichTextSpelling(RichEdit:TRichEdit);
    procedure CheckMemoTextSpelling(Memo:TMemo);
    property Active:boolean read FActive;
    property LetterChars:TSpellCheckletters read FLetterChars write FLetterChars;
  published
    property Language:TSpellCheckLanguage read FLanguage write FLanguage;
    property CompletedMessage:boolean read FCompletedMessage write FCompletedMessage;
    property Color:TColor read FColor write FColor;
    property Font:TFont read FFont write SetFFont;
    property BeforeCorrection:TSpellCheckBeforeCorrection
                              read FBeforeCorrection  write FBeforeCorrection;
    property AfterCorrection:TSpellCheckAfterCorrection
                              read FAfterCorrection   write FAfterCorrection;
    property OnCorrection:TSpellCheckOnCorrection
                              read FOnCorrection      write FOnCorrection;
    property ReplaceDialog:TSpellCheckReplacement
                              read FReplaceDialog     write FReplaceDialog;
  end;

procedure Register;

// -----------------------------------------------------------------------------
implementation
uses variants;

// Mapped Hex values for ord(FLanguage)
const LanguageArray:array [0..63] of integer =
                            ($0,$400,$406,$407,$807,$C09,$809,$409,
                             $1009,$1409,$1C09,$40A,$40C,$C0C,$410,
                             $413,$414,$814,$416,$816,$40B,$41D,$403,
                             $408,$41F,$419,$405,$40E,$415,$424,$42D,
                             $43E,$411,$412,$804,$404,$100C,$430,$431,
                             $432,$433,$434,$435,$436,$401,$40D,$41B,
                             $429,$418,$41A,$422,$423,$425,$426,$42F,
                             $81A,$C1A,$40F,$80C,$813,$402,$80A,$C0A,$810);

// Change to Component Pallete of choice
procedure Register;
begin
  RegisterComponents('Win95', [TSpellCheck]);
end;

// TSpellCheck
constructor TSpellCheck.Create(AOwner:TComponent);
begin inherited Create(AOwner);
  // Defaults
  FLetterChars:=['A'..'Z','a'..'z']; FCompletedMessage:=true;
  FColor:=clWindow; FFont:=TFont.Create; FReplaceDialog:=repDefault;
  FLanguage:=wdEnglishUS;

  // Don't create an ole server at design time
  if not (csDesigning in ComponentState) then begin try
        MsWordApp:=CreateOleObject('Word.Application');
        FActive:=true; MsWordApp.Documents.Add;
      except on E: Exception do begin
           MessageDlg('Cannot Connect to MS Word',mtError,[mbOk],0);
           FActive:=false;
        end;
      end;
  end;
end;


destructor TSpellCheck.Destroy;
begin FFont.Free;
  if FActive and not (csDesigning in ComponentState)then begin
     MsWordApp.Quit; MsWordApp:=VarNull; end;
  inherited Destroy;
end;

// ======================================
// Property Get/Set methods
// ======================================

procedure TSpellCheck.SetFFont(NewValue:TFont);
begin FFont.Assign(NewValue); end;

// ===========================================
// Return a list of synonyms for single word
// ===========================================

function TSpellCheck.GetSynonyms(StrWord:string; Synonyms:TStrings):boolean;
var SynInfo:OleVariant; i,j:integer; TS:OleVariant; Retvar:boolean;
begin Synonyms.Clear;
  if FActive then begin
      SynInfo:=MsWordApp.SynonymInfo[StrWord,LanguageArray[ord(FLanguage)]];
      for i:=1 to SynInfo.MeaningCount do begin
          TS:=SynInfo.SynonymList[i];
          // Many thanks to Jose Luis Tirado for the length of
          // "Variant array of OLE strings" - TS
          // These arrays are always one dimension (otherwise we should
          // iterate through them using the VarArrayDimCount function)
          for j:=VarArrayLowBound(TS, 1) to VarArrayHighBound(TS, 1) do Synonyms.Add(TS[j]);
      end;
      RetVar:=SynInfo.Found;
  end
  else RetVar:=false;
  Result:=RetVar;
end;

// =======================================
// Check the spelling of a single word
// Suggestions returned in TStrings
// =======================================

function TSpellCheck.CheckWordSpelling(StrWord:string; Suggestions:TStrings):boolean;
var Retvar:boolean; i:integer;
begin RetVar:=false; Suggestions.Clear;
   if FActive then begin
      if MsWordApp.CheckSpelling(StrWord) then RetVar:=true
      else begin
         MsSuggestions:=MsWordApp.GetSpellingSuggestions(StrWord);
         for i:=1 to MsSuggestions.Count do Suggestions.Add(MsSuggestions.Item(i));
         MsSuggestions:=VarNull;
      end;
  end;
  Result:=RetVar;
end;

// ======================================================
// Check the spelling text of a string with option to
// Replace words. Correct string returned in var StrText
// ======================================================

procedure TSpellCheck.CheckTextSpelling(var StrText:string);
var StartPos,CurPos,WordsChanged:integer; ChkWord,UserWord:string; EoTxt:boolean;

    procedure GetNextWordStart;
    begin ChkWord:='';
      // Thanx Tommi for bug fix
      while (StartPos <= length(StrText)) and (not (StrText[StartPos] in FLetterChars))
            do inc(StartPos);
      CurPos:=StartPos;
    end;

begin
  if FActive and (length(StrText) > 0) then begin
    MakeForm; StartPos:=1; EoTxt:=false; WordsChanged:=0; GetNextWordStart;
    while not EoTxt do begin
       // Is it a letter ?
       if StrText[CurPos] in FLetterChars then begin
          ChkWord:=ChkWord + StrText[CurPos]; inc(CurPos);
       end
       else begin
          // Word end found - check spelling
          if not CheckWordSpelling(ChkWord,FLbox.Items) then begin
             if Assigned(FBeforeCorrection) then FBeforeCorrection(self,ChkWord,FLbox.Items);

             // Default replacement dialog
             if FReplaceDialog = repDefault then begin
                FEbox.Text:=ChkWord; FForm.ShowModal;

                if FForm.ModalResult = mrOk then begin
                   // Change mispelt word
                   Delete(StrText,StartPos,length(ChkWord));
                   Insert(FEbox.Text,StrText,StartPos);
                   CurPos:=StartPos + length(FEbox.Text);

                   if ChkWord <> FEbox.Text then begin inc(WordsChanged);
                     if Assigned(FAfterCorrection) then
                        FAfterCorrection(self,ChkWord,FEbox.Text);
                   end;
                end
             end
             else begin
                // User defined replacemnt routine
                UserWord:=ChkWord;
                if Assigned(FOnCorrection) then FOnCorrection(self,UserWord);
                Delete(StrText,StartPos,length(ChkWord));
                Insert(UserWord,StrText,StartPos);
                CurPos:=StartPos + length(UserWord);

                 if ChkWord <> UserWord then begin inc(WordsChanged);
                    if Assigned(FAfterCorrection) then
                       FAfterCorrection(self,ChkWord,UserWord);
                 end;
             end;
          end;

          StartPos:=CurPos; GetNextWordStart; EoTxt:=(StartPos > length(StrText));
       end;
    end;

    CloseForm;
    if FCompletedMessage then
       MessageDlg('Spell Check Complete' + #13#10 +
                  IntToStr(WordsChanged) + ' words changed',mtInformation,[mbOk],0);
  end
  else
    if not FActive then MessageDlg('Spell Check not Active',mtError,[mbOk],0)
    else
       if FCompletedMessage then
          MessageDlg('Spell Check Complete'+#13#10+'0 words changed',mtInformation,[mbOk],0);
end;



// =============================================================
// Check the spelling of RichText with option to
// Replace words (in situ replacement direct to RichEdit.Text)
// Changed slightly to accomodate Win2000 (DefAttributes acts
// differently to W98)
// =============================================================

procedure TSpellCheck.CheckRichTextSpelling(RichEdit:TRichEdit);
var StartPos,CurPos,WordsChanged:integer; StrText,ChkWord,UserWord:string; SaveHide,EoTxt:boolean;

    procedure GetNextWordStart;
    begin ChkWord:='';
      while (not (StrText[StartPos] in FLetterChars)) and (StartPos <= length(StrText)) do inc(StartPos);
      CurPos:=StartPos;
    end;

begin
  SaveHide:=RichEdit.HideSelection; RichEdit.HideSelection:=false; StrText:=RichEdit.Text;
  if FActive and (length(StrText) > 0) then begin
    MakeForm; StartPos:=1; EoTxt:=false; WordsChanged:=0; GetNextWordStart;

    while not EoTxt do begin
       // Is it a letter ?
       if StrText[CurPos] in FLetterChars then begin
          ChkWord:=ChkWord + StrText[CurPos]; inc(CurPos);
       end
       else begin
          // Word end found - check spelling
          if not CheckWordSpelling(ChkWord,FLbox.Items) then begin
             if Assigned(FBeforeCorrection) then
                FBeforeCorrection(self,ChkWord,FLbox.Items);

             // Default replacement dialog
             if FReplaceDialog = repDefault then begin
                FEbox.Text:=ChkWord; RichEdit.SelStart:=StartPos - 1;
                RichEdit.SelLength:=length(ChkWord); FForm.ShowModal;

                if FForm.ModalResult = mrOk then begin
                   // Change mispelt word
                   Delete(StrText,StartPos,length(ChkWord));
                   Insert(FEbox.Text,StrText,StartPos);
                   CurPos:=StartPos + length(FEbox.Text);
                   RichEdit.SelText:=FEbox.Text;

                   if ChkWord <> FEbox.Text then begin inc(WordsChanged);
                     if Assigned(FAfterCorrection) then
                        FAfterCorrection(self,ChkWord,FEbox.Text);
                   end;
                end
             end
             else begin
                // User defined replacemnt routine
                UserWord:=ChkWord; RichEdit.SelStart:=StartPos - 1;
                RichEdit.SelLength:=length(ChkWord);
                if Assigned(FOnCorrection) then FOnCorrection(self,UserWord);
                Delete(StrText,StartPos,length(ChkWord));
                Insert(UserWord,StrText,StartPos);
                CurPos:=StartPos + length(UserWord);
                RichEdit.SelText:=UserWord;

                 if ChkWord <> UserWord then begin inc(WordsChanged);
                    if Assigned(FAfterCorrection) then
                       FAfterCorrection(self,ChkWord,UserWord);
                 end;
             end;
          end;

          StartPos:=CurPos; GetNextWordStart; EoTxt:=(StartPos > length(StrText));
       end;
    end;

    CloseForm; RichEdit.HideSelection:=SaveHide;
    if FCompletedMessage then
       MessageDlg('Spell Check Complete' + #13#10 +
                  IntToStr(WordsChanged) + ' words changed',mtInformation,[mbOk],0);
  end
  else
    if not FActive then MessageDlg('Spell Check not Active',mtError,[mbOk],0)
    else
       if FCompletedMessage then
          MessageDlg('Spell Check Complete'+#13#10+'0 words changed',mtInformation,[mbOk],0);
end;


// =============================================================
// Check the spelling of Memo with option to
// Replace words (in situ replacement direct to Memo.Text)
// =============================================================

procedure TSpellCheck.CheckMemoTextSpelling(Memo:TMemo);
var StartPos,CurPos,WordsChanged:integer; StrText,ChkWord,UserWord:string; SaveHide,EoTxt:boolean;

    procedure GetNextWordStart;
    begin ChkWord:='';
      while (not (StrText[StartPos] in FLetterChars)) and (StartPos <= length(StrText)) do inc(StartPos);
      CurPos:=StartPos;
    end;

begin
  SaveHide:=Memo.HideSelection; Memo.HideSelection:=false; StrText:=Memo.Text;
  if FActive and (length(StrText) > 0) then begin
    MakeForm; StartPos:=1; EoTxt:=false; WordsChanged:=0; GetNextWordStart;

    while not EoTxt do begin
       // Is it a letter ?
       if StrText[CurPos] in FLetterChars then begin
          ChkWord:=ChkWord + StrText[CurPos]; inc(CurPos);
       end
       else begin
          // Word end found - check spelling
          if not CheckWordSpelling(ChkWord,FLbox.Items) then begin
             if Assigned(FBeforeCorrection) then FBeforeCorrection(self,ChkWord,FLbox.Items);

             // Default replacement dialog
             if FReplaceDialog = repDefault then begin
                FEbox.Text:=ChkWord; Memo.SelStart:=StartPos - 1;
                Memo.SelLength:=length(ChkWord); FForm.ShowModal;

                if FForm.ModalResult = mrOk then begin
                   // Change mispelt word
                   Delete(StrText,StartPos,length(ChkWord));
                   Insert(FEbox.Text,StrText,StartPos);
                   CurPos:=StartPos + length(FEbox.Text);
                   Memo.SelText:=FEbox.Text;

                   if ChkWord <> FEbox.Text then begin inc(WordsChanged);
                     if Assigned(FAfterCorrection) then
                        FAfterCorrection(self,ChkWord,FEbox.Text);
                   end;
                end
             end
             else begin
                // User defined replacemnt routine
                UserWord:=ChkWord; Memo.SelStart:=StartPos - 1;
                Memo.SelLength:=length(ChkWord);
                if Assigned(FOnCorrection) then FOnCorrection(self,UserWord);
                Delete(StrText,StartPos,length(ChkWord));
                Insert(UserWord,StrText,StartPos);
                CurPos:=StartPos + length(UserWord);
                Memo.SelText:=UserWord;

                 if ChkWord <> UserWord then begin inc(WordsChanged);
                    if Assigned(FAfterCorrection) then
                       FAfterCorrection(self,ChkWord,UserWord);
                 end;
             end;
          end;

          StartPos:=CurPos; GetNextWordStart; EoTxt:=(StartPos > length(StrText));
       end;
    end;

    Memo.HideSelection:=SaveHide; CloseForm;
    if FCompletedMessage then
       MessageDlg('Spell Check Complete' + #13#10 +
                  IntToStr(WordsChanged) + ' words changed',mtInformation,[mbOk],0);
  end
  else
    if not FActive then MessageDlg('Spell Check not Active',mtError,[mbOk],0)
    else
       if FCompletedMessage then
          MessageDlg('Spell Check Complete'+#13#10+'0 words changed',mtInformation,[mbOk],0);
end;


// =========================================
// Create default replacement form
// =========================================

procedure TSpellCheck.MakeForm;
begin // Correction form container
  FForm:=TForm.Create(nil); FForm.Position:=poScreenCenter;
  FForm.BorderStyle:=bsDialog; FForm.Height:=240; FForm.Width:=210;
  // Remove form's caption
  SetWindowLong(FForm.Handle,GWL_STYLE, GetWindowLong(FForm.Handle,GWL_STYLE) AND NOT WS_CAPTION);
  FForm.ClientHeight:=FForm.Height;

  // Edit box of offending word
  FEbox:=TEdit.Create(FForm); FEbox.Parent:=FForm; FEbox.Top:=8; FEbox.Left:=8;
  FEbox.Width:=185; FEBox.Font:=FFont; FEbox.Color:=FColor;

  // Suggestion list box
  FLbox:=TListBox.Create(FForm); FLbox.Parent:=FForm; FLbox.Top:=32; FLbox.Left:=8;
  FLbox.Width:=185; FLbox.Height:=193; FLbox.Color:=FColor; FLbox.Font:=FFont;
  FLbox.OnClick:=SuggestedClick; FLbox.OnDblClick:=SuggestedClick;

  // Cancel Button
  FCancelBtn:=TBitBtn.Create(FForm); FCancelBtn.Parent:=FForm; FCancelBtn.Top:=232;
  FCancelBtn.Left:=8; FCancelBtn.Kind:=bkCancel; FCancelBtn.Caption:='Ignore';

  // Change Button
  FChangeBtn:=TBitBtn.Create(FForm); FChangeBtn.Parent:=FForm; FChangeBtn.Top:=232;
  FChangeBtn.Left:=120; FChangeBtn.Kind:=bkOk; FChangeBtn.Caption:='Change';
end;

// =============================================
// Close the correction form and free memory
// =============================================

procedure TSpellCheck.CloseForm;
begin FChangeBtn.Free; FCancelBtn.Free; FLbox.Free; FEbox.Free; FForm.Free; end;

// ====================================================
// FLbox on click event to populate the edit box
// with selected suggestion (OnClick/OnDblClick)
// ====================================================

procedure TSpellCheck.SuggestedClick(Sender:TObject);
begin FEbox.Text:=FLbox.Items[FLbox.ItemIndex]; end;

end.

-------------------------------------------------------------
Question/Problem/Abstract:
.. Create (procedure)
.. Free (procedure)
.. Active (property)
.. CheckSpelling (function)

This serves as an example of using MS Word to check the spelling of a word and to give a list of suggested correct spellings. I am using it as part of a VCL that will check a string of Text word by word and selectively replace any mispelt words. (For the full VCL see my atricle 1712 "VCL MS Word Spell Check and Thesaurus" under the VCL General category.)

In the supplied example the text of an edit box and the items property of a list box is passed to the class function CheckSpelling(). This function returns true if the word is not mispelt. If the return value is false then the list of suggested spelling are returned in the
listbox.
Answer:

Code: Select all

unit Unit1;
interface
uses Windows, Sysutils, Forms, Buttons, StdCtrls,
     Classes, Dialogs, ComObj, Controls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

  // Actual Spell Checker Class
  TSpellCheck = class(TObject)
  private
    MsWordApp, MsSuggestions : OleVariant;
    FActive : boolean;
  public
    constructor Create;
    destructor Destroy; override;
    function CheckSpelling(StrWord : string; Suggestions : TStrings) : boolean;
    property Active : boolean read FActive;
  end;


var Form1: TForm1;
implementation
{$R *.DFM}

// Spell Checker Methods --------------------------------------------

constructor TSpellCheck.Create;
begin try
    MsWordApp := CreateOleObject('Word.Application');
    FActive := true; MsWordApp.Documents.Add;
  except
    on E: Exception do begin
       MessageDlg('Cannot Connect to MS Word',mtError,[mbOk],0);
       FActive := false;
    end;
  end;
end;


destructor TSpellCheck.Destroy;
begin
  if FActive then begin MsWordApp.Quit;  MsWordApp := VarNull;  end;
  inherited Destroy;
end;


function TSpellCheck.CheckSpelling(StrWord : string; Suggestions : TStrings) : boolean;
var Retvar : boolean; i : integer;
begin  RetVar := false;  Suggestions.Clear;

   if FActive then begin
      if MsWordApp.CheckSpelling(StrWord) then
         RetVar := true
      else begin
         MsSuggestions := MsWordApp.GetSpellingSuggestions(StrWord);
         for i := 1 to MsSuggestions.Count do Suggestions.Add(MsSuggestions.Item(i));
         MsSuggestions := VarNull;    
      end;
  end;

  Result := RetVar;
end;


// -----------------------------------------------------------------
// SIMPLE Example.

var SPcheck : TSpellCheck;

procedure TForm1.FormShow(Sender: TObject);
begin SPcheck := TSpellCheck.Create; end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin SPcheck.Free; end;

procedure TForm1.Button1Click(Sender: TObject);
begin if SPcheck.CheckSpelling(Edit1.Text,ListBox1.Items) then
     Label1.Caption := 'Word OK'  else  Label1.Caption := 'Mispelling'; end;

end.
[/code]
dkounal
Posts: 24
Joined: Sat Aug 27, 2005 4:51 pm
Location: Greece

Post by dkounal »

Old but usefull when you want special dictionnairies that exist only in word and there is no other way to use transform dictionnairies from MS word to other spellcheckers.
I did not found yet a way to select the language in the spellchecking. Anyone, with msdn subscription to tell us how?
Thank you in advance,
Dimitris
Post Reply